求老师帮忙看看精简一下代码

王跃峰

Sub AA()
Dim Arr1, Arr2, Arr3
Arr1 = Array(1, 11, 12, 13, 14, 15, 25, 26, 27, 28, 29)
For Each i In Arr1
    With Sheets(i)
        .[a7] = "甲班(8:00-20:00)"
        .[a10] = "乙班(20:00-次8:00)"
    End With
Next
Arr2 = Array(4, 5, 6, 7, 8, 18, 19, 20, 21, 22)
For Each i In Arr2
    With Sheets(i)
        .[a7] = "甲班(20:00-次8:00)"
        .[a10] = "乙班(8:00-20:00)"
    End With
Next
Arr3 = Array(2, 3, 9, 10, 16, 17, 23, 24, 30, 31)
For Each i In Arr3
    With Sheets(i)
        .[a7] = "甲班"
        .[a10] = "乙班"
        .[aw7] = "休息"
        .[aw10] = "休息"
    End With
Next
End Sub

WANT-T

代码看着挺好的，不用精简吧！

王跃峰

上面数字有规律，能不能再精简一下1，2，3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31

lkqsmxw

Sub AA()
Dim Arr1, Arr2, Arr3
Arr1 = "1, 11, 12, 13, 14, 15, 25, 26, 27, 28, 29"
Arr2 = "4, 5, 6, 7, 8, 18, 19, 20, 21, 22"
Arr3 = "2, 3, 9, 10, 16, 17, 23, 24, 30, 31"
For Each i In Sheets
With i
If Arr1 Like "*" & i.Name & ",*" = True Or Arr1 Like ",*" & i.Name & "*" = True Then .[a7] = "甲班(8:00-20:00)": .[a10] = "乙班(20:00-次8:00)"
If Arr2 Like "*" & i.Name & ",*" = True Or Arr2 Like ",*" & i.Name & "*" = True Then .[a7] = "甲班(20:00-次8:00)": .[a10] = "乙班(8:00-20:00)"
If Arr3 Like "*" & i.Name & ",*" = True Or Arr3 Like ",*" & i.Name & "*" = True Then .[a7] = "甲班": .[a10] = "乙班": .[aw7] = "休息": .[aw10] = "休息"
End With
Next i
End Sub

半百

王跃峰

Sub AA()
d = #6/30/2022#
a = Array("(20:00-次8:00)", "(8:00-20:00)", "(20:00-次8:00)", "", "")
For i = 1 To 31
With Sheets(i)
n = Weekday(d + i, 2)
If n < 6 Then
n = DatePart("ww", d + i) Mod 2
Else
.[aw7] = "休息"
.[aw10] = "休息"
n = 3
End If
.[a7] = "甲班" & a(n)
.[a10] = "乙班" & a(1 + n)
End With
Next
End Sub

王跃峰

半百 发表于 2023-3-30 13:35

感谢您的帮助，您巧用了weekday函数，假如5天一到班，只休息1天又如何变更？

王跃峰

lkqsmxw 发表于 2023-3-30 12:31
Sub AA()
Dim Arr1, Arr2, Arr3
Arr1 = "1, 11, 12, 13, 14, 15, 25, 26, 27, 28, 29"

感谢您的帮助，但不符合要求，工作表名称不含1，2，3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31这些数