查找数字组合

423binbin

根据图片样式寻找数字组合

zldccmx

zldccmx

代码供参考

1. Sub 选数()
   
2.     Dim X(1 To 3), Y(1 To 3), RegX, S(1 To 3)
   
3.     Set wsData = Worksheets("Sheet14")
   
4.     Set RegX = CreateObject("VBSCRIPT.REGEXP")
   
5.     Y(1) = wsData.Range("V21")
   
6.     Y(2) = wsData.Range("W21")
   
7.     Y(3) = wsData.Range("X21")
   
8.     RegX.Pattern = ".*[" & Join(Y, "].*,[") & "].*" '".*[9].*,[8].*,[5].*"
   
9.     RegX.Global = True
   
10.     wsData.Range("B3:t22").Font.Color = -11489280
    
11.     For a = 3 To 22
    
12.         X(1) = wsData.Cells(a, 2) & "," & wsData.Cells(a, 3) & "," & wsData.Cells(a, 4)
    
13.         X(2) = X(1) & "," & wsData.Cells(a + 1, 2) & "," & wsData.Cells(a + 1, 3) & "," & wsData.Cells(a + 1, 4)
    
14.         X(3) = X(2) & "," & wsData.Cells(a + 2, 2) & "," & wsData.Cells(a + 2, 3) & "," & wsData.Cells(a + 2, 4)
    
15.         For b = 3 To 1 Step -1
    
16.             If RegX.Test(X(b)) Then
    
17.                 S(1) = InStr(X(b), Y(1))
    
18.                 S(2) = S(1) + InStr(Mid(X(b), Start:=(S(1) + 1)), Y(2))
    
19.                 S(3) = S(2) + InStr(Mid(X(b), Start:=S(2) + 1), Y(3))
    
20.                 For c = 1 To 3
    
21.                     Select Case S(c)
    
22.                     Case 1: wsData.Cells(a, 2).Font.Color = vbRed
    
23.                     Case 3: wsData.Cells(a, 3).Font.Color = vbRed
    
24.                     Case 5: wsData.Cells(a, 4).Font.Color = vbRed
    
25.                     Case 7: wsData.Cells(a + 1, 2).Font.Color = vbRed
    
26.                     Case 9: wsData.Cells(a + 1, 3).Font.Color = vbRed
    
27.                     Case 11: wsData.Cells(a + 1, 4).Font.Color = vbRed
    
28.                     Case 13: wsData.Cells(a + 2, 2).Font.Color = vbRed
    
29.                     Case 15: wsData.Cells(a + 2, 3).Font.Color = vbRed
    
30.                     Case 17: wsData.Cells(a + 2, 4).Font.Color = vbRed
    
31.                     End Select
    
32.                 Next
    
33.                 Exit For
    
34.             End If
    
35.         Next
    
36.     Next
    
37. End Sub

复制代码