VBA循环填充日历式单元格时跳过周日（第7列）的问题排查

我需要按日历格式在一行单元格中填充指定天数的数据，规则是：跳过所有代表周日的单元格，写完周六后直接在下一个周一的单元格继续写入。

最初尝试用MOD(number, divisor)=0判断每第7天跳过，但第一次跳过周日之后，循环偏移计算出现滞后，导致第二个周日时错误跳过周一（第16个单元格）而非周日（第14个单元格）；后来改用硬编码指定跳过7、13、19等位置，但这种方法仅在天数不超过25天时有效，无法适配更长的周期。

原VBA代码如下：

Sub t1_Sunday4()
Dim in1Days, in2Value, jj1 As Integer
Dim os_skip, os_New As Integer
Dim x_ShortCondt As Boolean
os_New = 1
in1Days = Range("A3")
in2Value = Range("B3")

Sub t1()
  Dim in1Days, in2Value, jj1 As Integer
  Dim os_skip, os_New As Integer
  Dim x_ShortCondt As Boolean
  os_New = 1
  in1Days = Range("A3")
  in2Value = Range("B3")
  x_ShortCondt = False


For jj1 = 1 To in1Days
Cells(5, 5 + jj1) = jj1 ' # Iteration

If x_ShortCondt = True Then

    'MOD CONDITION
    If (jj1 Mod 7) = 0 Then ' Condition for every 7th Day
        os_skip = jj1 / 7
        os_New = jj1 + os_skip 'Off Set Cell number
    End If
    
Else

    'HARD CODING THE CONDITION
    If jj1 = 7 Or jj1 = 13 Or jj1 = 19 Or jj1 = 25 _
    Or jj1 = 31 Or jj1 = 37 Or jj1 = 37 Or jj1 = 43 _
    Or jj1 = 49 Then
        os_skip = jj1 / 7
        os_New = jj1 + os_skip
    End If
    
End If
   'POPULATE CELLS
    Cells(3, 5 + os_New) = in2Value ' Value to add in cell
    
    ' CONTROL LOOP AND OFFSET VALUES
    Cells(6, 5 + os_New) = jj1      ' Iteration for said Value after Offset
    Cells(7, 5 + os_New) = os_New   ' Value for Offset
    os_New = os_New + 1

Next jj1
End Sub

问题分析 #

原代码的核心问题在于混淆了天数计数和单元格位置偏移的逻辑：

• 用天数变量jj1直接计算偏移，忽略了每跳过一个周日会导致单元格位置比天数多一个偏移量的事实，导致后续的周日判断完全错位。
• 硬编码跳过位置的方式缺乏扩展性，无法适配超过49天的场景，且容易出现重复（如代码中重复写了jj1=37）。

解决方案 #

我们需要分离天数计数和单元格位置的跟踪，通过计算每个天数对应的实际单元格位置，或者遍历单元格时判断是否为周日来实现跳过逻辑。以下是两种可行的实现方式：

方法一：按天数计算对应单元格位置

通过数学计算直接定位每个天数对应的单元格，自动跳过周日位置：

Sub FillCalendarSkipSunday()
    Dim totalDays As Integer
    Dim fillValue As Variant
    Dim currentDay As Integer
    Dim targetCol As Integer
    Dim startCol As Integer
    
    ' 读取输入参数
    totalDays = Range("A3").Value
    fillValue = Range("B3").Value
    startCol = 6 ' 对应原代码的5+1起始列
    
    For currentDay = 1 To totalDays
        ' 计算目标列：每6天（周一到周六）后跳过1个单元格（周日）
        targetCol = startCol + currentDay + Int((currentDay - 1) / 6)
        
        ' 填充数据及辅助信息
        Cells(3, targetCol) = fillValue
        Cells(5, targetCol) = currentDay ' 标记当前天数
        Cells(6, targetCol) = currentDay ' 迭代次数
        Cells(7, targetCol) = targetCol - 5 ' 偏移量（对应原os_New）
    Next currentDay
End Sub

方法二：遍历单元格，跳过周日位置

模拟遍历日历的过程，遇到周日单元格直接跳过，直到完成指定天数的填充：

Sub FillCalendarSkipSunday2()
    Dim totalDays As Integer
    Dim fillValue As Variant
    Dim currentDay As Integer
    Dim currentCol As Integer
    Dim startCol As Integer
    
    totalDays = Range("A3").Value
    fillValue = Range("B3").Value
    startCol = 6
    currentDay = 1
    currentCol = startCol
    
    Do While currentDay <= totalDays
        ' 判断当前单元格是否为周日：每第7个单元格（起始列后第6、13、20...位）
        If (currentCol - startCol + 1) Mod 7 = 0 Then
            ' 周日单元格，跳过不填充
            currentCol = currentCol + 1
        Else
            ' 填充数据及辅助信息
            Cells(3, currentCol) = fillValue
            Cells(5, currentCol) = currentDay
            Cells(6, currentCol) = currentDay
            Cells(7, currentCol) = currentCol - 5
            
            currentDay = currentDay + 1
            currentCol = currentCol + 1
        End If
    Loop
End Sub

说明 #

• 两种方法都能自动适配任意天数，无需硬编码跳过位置。
• 方法一更高效，通过数学计算直接定位；方法二更直观，贴合日历遍历逻辑。
• 代码中保留了原代码的辅助信息写入，可根据需求删除。

内容的提问来源于stack exchange，提问作者jjjhhh