Option Explicit
Sub 檢測_選取問題格()
Dim i&, Arr, n, xR As Range, C%, R&
Arr = ActiveSheet.UsedRange
For C = 1 To UBound(Arr, 2)
For R = 1 To UBound(Arr)
If InStr("/主/副/●/", "/" & Trim(Arr(R, C)) & "/") Then
n = n + 1
If n >= 7 Then
If Not xR Is Nothing Then
Set xR = Union(xR, Cells(R, C))
Else
Set xR = Cells(R, C)
End If
End If
Else
n = 0
End If
Next
n = 0
Next
If Not xR Is Nothing Then
Application.Goto xR
Else
MsgBox "沒有連續七天上班!"
End If
End Sub