[已解决]如何将连续上班超过7天得人标注出来（帮忙修改一下代码）

jian82372387

需求：附件是如何将连续上班超过7天以上得人标注出来，除了休息、年休和各种假期（如病假、事假、陪产假、育儿假等），其他英文字母或者中文、数字都表示是上班，如果有某个人连续上班超过7天及以上将他的名字标红底，并把他连续上7天以上的班在考勤表也标注个颜色。如文件中红色/橙色底色要的效果。用函数或者VBA解决都可以。

下面是之前论坛上坛友给的代码，请问需要如何修改一下。
Sub test()
Dim Arr, xU, s%
Arr = [a1].CurrentRegion
Set xU = [a3]
For i = 3 To UBound(Arr)
    For j = 3 To UBound(Arr, 2)
        If InStr(Arr(i, j), "休") = False Then
            s = s + 1: Set xU = Union(xU, Cells(i, j))
            If s > 6 Then: xU.Interior.ColorIndex = 7: Cells(i, 2).Interior.ColorIndex = 3
        Else
            s = 0: Set xU = Nothing: Set xU = [a3]
        End If
    Next
    s = 0: Set xU = Nothing: Set xU = [a3]
Next
[a3].Interior.ColorIndex = xlNone
End Sub

最佳答案

月排行榜 / 总排行榜

sam-wang

2022-7-3 00:32

jian82372387 发表于 2022-7-2 22:59
不好意思，是我没列举出多种情况，有些班会用中文显示，就是除了休息、年休和各种假期（如病假、事假、陪 ...

請再測試看看，謝謝
Sub test()
Dim Arr, xU, s%
Arr = [a1].CurrentRegion
Set xU = [a3]
For i = 3 To UBound(Arr)
    For j = 3 To UBound(Arr, 2)
        If Arr(i, j) Like "*班" Or Arr(i, j) Like "[A-z]*[0-9]" Or Arr(i, j) Like "[A-z]*" Or Arr(i, j) Like "[0-9]*" Then
            s = s + 1: Set xU = Union(xU, Cells(i, j))
            If s > 6 Then xU.Interior.ColorIndex = 45: Cells(i, 2).Interior.ColorIndex = 3
        Else
            s = 0: Set xU = Nothing: Set xU = [a3]
        End If
    Next
    s = 0: Set xU = Nothing: Set xU = [a3]
Next
[a3].Interior.ColorIndex = xlNone
End Sub

跳转到最佳答案楼层

sam-wang

請測試看看，謝謝
Sub test()
Dim Arr, xU, s%
Arr = [a1].CurrentRegion
Set xU = [a3]
For i = 3 To UBound(Arr)
    For j = 3 To UBound(Arr, 2)
        If Arr(i, j) Like "[A-z]*[0-9]" Or Arr(i, j) Like "[A-z]*" Or Arr(i, j) Like "[0-9]*" Then
            s = s + 1: Set xU = Union(xU, Cells(i, j))
            If s > 6 Then xU.Interior.ColorIndex = 45: Cells(i, 2).Interior.ColorIndex = 3
        Else
            s = 0: Set xU = Nothing: Set xU = [a3]
        End If
    Next
    s = 0: Set xU = Nothing: Set xU = [a3]
Next
[a3].Interior.ColorIndex = xlNone
End Sub

jian82372387

sam-wang 发表于 2022-7-2 07:29
請測試看看，謝謝
Sub test()
Dim Arr, xU, s%

有些问题，如果连续7天白班或者夜班无法标注，有些上班用中文表示，

sam-wang

jian82372387 发表于 2022-7-2 14:05
有些问题，如果连续7天白班或者夜班无法标注，有些上班用中文表示，

請問可附檔說明一下，謝謝

jian82372387

sam-wang 发表于 2022-7-2 15:17
請問可附檔說明一下，謝謝

不好意思，是我没列举出多种情况，有些班会用中文显示，就是除了休息、年休和各种假期（如病假、事假、陪产假、育儿假等）属于休息不需标注外，其他都属于上班需标注连续7天

sam-wang

jian82372387 发表于 2022-7-2 22:59
不好意思，是我没列举出多种情况，有些班会用中文显示，就是除了休息、年休和各种假期（如病假、事假、陪 ...

請再測試看看，謝謝
Sub test()
Dim Arr, xU, s%
Arr = [a1].CurrentRegion
Set xU = [a3]
For i = 3 To UBound(Arr)
    For j = 3 To UBound(Arr, 2)
        If Arr(i, j) Like "*班" Or Arr(i, j) Like "[A-z]*[0-9]" Or Arr(i, j) Like "[A-z]*" Or Arr(i, j) Like "[0-9]*" Then
            s = s + 1: Set xU = Union(xU, Cells(i, j))
            If s > 6 Then xU.Interior.ColorIndex = 45: Cells(i, 2).Interior.ColorIndex = 3
        Else
            s = 0: Set xU = Nothing: Set xU = [a3]
        End If
    Next
    s = 0: Set xU = Nothing: Set xU = [a3]
Next
[a3].Interior.ColorIndex = xlNone
End Sub

jian82372387

sam-wang 发表于 2022-7-3 00:32
請再測試看看，謝謝
Sub test()
Dim Arr, xU, s%

十分感谢