|
代码供参考
- Sub 选数()
- Dim X(1 To 3), Y(1 To 3), RegX, S(1 To 3)
- Set wsData = Worksheets("Sheet14")
- Set RegX = CreateObject("VBSCRIPT.REGEXP")
- Y(1) = wsData.Range("V21")
- Y(2) = wsData.Range("W21")
- Y(3) = wsData.Range("X21")
- RegX.Pattern = ".*[" & Join(Y, "].*,[") & "].*" '".*[9].*,[8].*,[5].*"
- RegX.Global = True
- wsData.Range("B3:t22").Font.Color = -11489280
- For a = 3 To 22
- X(1) = wsData.Cells(a, 2) & "," & wsData.Cells(a, 3) & "," & wsData.Cells(a, 4)
- X(2) = X(1) & "," & wsData.Cells(a + 1, 2) & "," & wsData.Cells(a + 1, 3) & "," & wsData.Cells(a + 1, 4)
- X(3) = X(2) & "," & wsData.Cells(a + 2, 2) & "," & wsData.Cells(a + 2, 3) & "," & wsData.Cells(a + 2, 4)
- For b = 3 To 1 Step -1
- If RegX.Test(X(b)) Then
- S(1) = InStr(X(b), Y(1))
- S(2) = S(1) + InStr(Mid(X(b), Start:=(S(1) + 1)), Y(2))
- S(3) = S(2) + InStr(Mid(X(b), Start:=S(2) + 1), Y(3))
- For c = 1 To 3
- Select Case S(c)
- Case 1: wsData.Cells(a, 2).Font.Color = vbRed
- Case 3: wsData.Cells(a, 3).Font.Color = vbRed
- Case 5: wsData.Cells(a, 4).Font.Color = vbRed
- Case 7: wsData.Cells(a + 1, 2).Font.Color = vbRed
- Case 9: wsData.Cells(a + 1, 3).Font.Color = vbRed
- Case 11: wsData.Cells(a + 1, 4).Font.Color = vbRed
- Case 13: wsData.Cells(a + 2, 2).Font.Color = vbRed
- Case 15: wsData.Cells(a + 2, 3).Font.Color = vbRed
- Case 17: wsData.Cells(a + 2, 4).Font.Color = vbRed
- End Select
- Next
- Exit For
- End If
- Next
- Next
- End Sub
复制代码
|
|