彩票数据标记颜色(三数相同)

Public d, dIsExists
Sub Main()
Dim arr(1 To 80000)
With Me
.Cells.Interior.ColorIndex = 0
r = .Cells(.Rows.Count, 1).End(xlUp).Row
For x = 1 To r
For y = x + 1 To r
k = k + 1
s = x & "," & y
arr(k) = s
Next
Next
For x = 1 To UBound(arr)
If Len(arr(x)) Then
arspl = Split(arr(x), ",")
Call CompareMethod(arspl(0) * 1, arspl(1) * 1)
End If
Next
End With
End Sub

Private Sub CompareMethod(rowFirst, rowSecond)
Dim arFirstRow, arSecondRow, arFirstRowColIndex, arSecondRowColIndex
Dim arDisExistsKey, arDisExistsItem
Set d = CreateObject("scripting.dictionary")
Set dIsExists = CreateObject("scripting.dictionary")
With Me
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("b1:g" & r)
arFirstRow = Application.Index(arr, rowFirst, 0)
For x = 1 To UBound(arFirstRow)
d(arFirstRow(x)) = x
Next

arSecondRow = Application.Index(arr, rowSecond, 0)
For y = 1 To UBound(arSecondRow)
If d.exists(arSecondRow(y)) Then
dIsExists(arSecondRow(y)) = y
k = k + 1
End If
Next
If k >= 3 Then
arDisExistsKey = dIsExists.keys
arFirstRowColIndex = GetDIndexCol(arDisExistsKey)
arSecondRowColIndex = dIsExists.items
Call ChangeColor(rowFirst, rowSecond, arFirstRowColIndex, arSecondRowColIndex)
End If
End With
End Sub

Private Function GetDIndexCol(ar)
For x = 0 To UBound(ar)
s = s & "," & d(ar(x))
Next
GetDIndexCol = Split(Mid(s, 2), ",")
End Function
Private Sub ChangeColor(rowFirst, rowSecond, arFirst, arSecond)
Dim rng As Range, rngSecRow As Range
'Cells.Interior.ColorIndex = 0
For x = 0 To UBound(arFirst)
col = arFirst(x) * 1 + 1
If rng Is Nothing Then
Set rng = Cells(rowFirst, col)
Else
Set rng = Union(rng, Cells(rowFirst, col))
End If
Next x

For x = 0 To UBound(arSecond)
col = arSecond(x) + 1
If rngSecRow Is Nothing Then
Set rngSecRow = Cells(rowSecond, col)
Else
Set rngSecRow = Union(rngSecRow, Cells(rowSecond, col))
End If
Next x
If Not rng Is Nothing Then rng.Interior.ColorIndex = 3
If Not rngSecRow Is Nothing Then rngSecRow.Interior.ColorIndex = 3
Set rng = Nothing
d.RemoveAll
dIsExists.RemoveAll
End Sub