如何做成下表

王跃峰

红色是为了醒目，区分用的

汉唐

请看附件.....

王跃峰

汉唐 发表于 2023-3-31 08:50
请看附件.....

您好，太感谢您了假如10天一倒班，怎么改？

王跃峰

Sub test()
Dim i As Long, r As Long
Dim arr
r = 63
arr = Cells(1, 1).Resize(r, 3)
For i = 2 To UBound(arr)
    If Weekday(arr(i, 1), 2) = 3 Then
        arr(i + 1, 1) = Empty
        arr(i, 3) = arr(i - 1, 3)
        GoTo line1
    End If
    If arr(i - 1, 3) = "甲班" Then
        arr(i, 3) = "乙班"
    Else
        arr(i, 3) = "甲班"
    End If
line1:
Next
Cells(1, 1).Resize(63, 3) = arr
End Sub

汉唐

10天倒班的

王跃峰

汉唐 发表于 2023-3-31 12:16
10天倒班的

太感谢您了

王跃峰

Sub test()
Dim i As Long, r As Long
Dim arr
arr = Cells(1, 1).Resize(64, 3)
s = arr(2, 1) '基准日
arr(2, 3) = "甲班"
For i = 3 To UBound(arr)
        If (arr(i, 1) - s) Mod 10 = 0 And arr(i, 1) > 0 Then
                arr(i, 3) = arr(i - 1, 3)
                GoTo line1
        End If
        If arr(i - 1, 3) = "甲班" Then
                arr(i, 3) = "乙班"
        Else
                arr(i, 3) = "甲班"
        End If
        line1:
Next
Cells(1, 1).Resize(63, 3) = arr
End Sub