问在vba中查找2列中的相似数字时出现问题

EN

Sub totolotek()
    Dim i As Integer
    Dim x As Integer
    Dim j As Integer
    Dim liczba As Integer
    Dim suma As Integer
    Dim ileLosowan As Integer
    Dim str_B As String, str_C As String, str_BC As String
    Dim max_rand As Long
    
    
    ileLosowan = 20                 ' you can change the number of element in the column
    max_rand = 49                   ' max randum number
    start_row = 2                   'start_row
    
    str_BC = "B2:C" & ileLosowan
    str_B = "B2:B" & ileLosowan
    str_C = "C2:C" & ileLosowan
    
    Range(str_BC).Interior.Color = RGB(135, 134, 125)
    Range(str_B).Font.ColorIndex = 5
    Range(str_C).Font.ColorIndex = 5


    Randomize
    For i = start_row To ileLosowan
        x = Int(Rnd * (max_rand) + 1)
        Range("C" & i) = x
    Next i
    For i = start_row To ileLosowan
        x = Int(Rnd * (max_rand) + 1)
        Range("B" & i) = x
    Next i

liczba_array = Range("B" & start_row & ":B" & ileLosowan).Value2
liczbe_array = Range("C" & start_row & ":C" & ileLosowan).Value2

ReDim ID_array(1 To 1)
ID_array(1) = max_rand + 1
Count = 1


For i = 1 To UBound(liczba_array, 1)
    For j = 1 To UBound(liczbe_array, 1)
        For k = 1 To UBound(ID_array, 1)
            If ID_array(k) = j Then
                GoTo out
            End If
        Next k
            If liczba_array(i, 1) = liczbe_array(j, 1) Then
                Range("B" & (start_row + i - 1)).Interior.Color = RGB(150 + Count * 20, 0, 0)
                Range("C" & (start_row + j - 1)).Interior.Color = RGB(150 + Count * 20, 0, 0)
                suma = suma + 1
                ID_array(Count) = j
                Count = Count + 1
                ReDim Preserve ID_array(1 To Count)
                Exit For
            End If
    Next j
out:
Next i
Range("C" & ileLosowan + 2) = suma
End Sub

Dim i As Long, j As Long, arr As Variant, Total As Integer

For i = 2 To 7 'Rows to loop through in the column
    Total = 0
    arr = Split(Range("A" & i), ",") 'Split column A using the comma
    For j = 0 To UBound(arr) 'Loop through the split values
        If InStr(Range("B" & i), arr(j)) > 0 Then 'Find if value is within other column
            Total = Total + 1 'If it is, add 1 to total
        End If
    Next j
    Range("C" & i) = Total 'Write total to another column on same row
Next i

Public Function CountMatches(Cell As String, Rng As Range, Optional Delim As String)

Dim i As Long, j As Long, arr As Variant, Total As Integer

If Delim = "" Then Delim = ","

If Rng.Count > 1 Then
    CountMatches = "Please choose 1 cell to compare to."
    Exit Function
End If

Total = 0
arr = Split(Cell, Delim) 'Split column A using the comma

For j = 0 To UBound(arr) 'Loop through the split values
    If InStr(Rng, arr(j)) > 0 Then 'Find if value is within other column
        Total = Total + 1 'If it is, add 1 to total
    End If
Next j

CountMatches = Total

End Function