查找I列对应R列相同数字的所有下一行（下一个）有可能出现的数字集合

ruhong18

R列的数字是固定不变的，查找I列对应R列相同数字的所有下一行（下一个）有可能出现的数字集合，用逗号隔开，重复的数字支显示一次，显示在S列，重复2次以上的在T列显示，同样以逗号隔开，，显示在T列。                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        
                        

我行我速2008

Sub tt()
    On Error Resume Next
    Dim R1%, R2%, Ar, Br, Str$, Cr, Str2$, X%
    Dim Dic
    Set Dic = CreateObject("scripting.dictionary")
    Ar = Sheet2.Range("I1").CurrentRegion
    Br = Sheet2.Range("R1").CurrentRegion
    For R2 = 2 To UBound(Br)
        For R1 = 2 To UBound(Ar) - 1
            If Ar(R1, 1) = Br(R2, 1) Then
                If Dic.Exists(Ar(R1 + 1, 1)) Then
                    Dic(Ar(R1 + 1, 1)) = Dic(Ar(R1 + 1, 1)) + 1
                Else
                    Dic(Ar(R1 + 1, 1)) = 1
                    Str = Str & Ar(R1 + 1, 1) & ","
                End If
            End If
        Next R1
        If Dic.Count > 0 Then
            Cr = Application.Transpose(Array(Dic.keys, Dic.items))
            For X = 1 To UBound(Cr)
                 If Cr(X, 2) > 1 Then Str2 = Str2 & Cr(X, 1) & ","
            Next X
            Br(R2, 2) = Str: Str = ""
            Br(R2, 3) = Str2: Str2 = ""
            Dic.RemoveAll
        End If
    Next R2
    Sheet2.Range("R1").Resize(UBound(Br), 3) = Br
End Sub

我行我速2008

感觉是买彩票啊，一直不做彩票题。