楼主
liuguansky |
Q:如何依号码明细返回首尾相连的七星彩号码？
A:用如下代码可以实现 ：
- Sub justtest()
- Dim arr1, arr2, arr3, arr4, arr5, dic, i1, i2, i3, i4, i5, str1$
- Set dic = CreateObject("scripting.dictionary")
- arr1 = Cells(2, 1).Resize(Cells(1, 1).End(4).Row - 1, 1).Value
- arr2 = Cells(2, 2).Resize(Cells(1, 2).End(4).Row - 1, 1).Value
- arr3 = Cells(2, 3).Resize(Cells(1, 3).End(4).Row - 1, 1).Value
- arr4 = Cells(2, 4).Resize(Cells(1, 4).End(4).Row - 1, 1).Value
- arr5 = Cells(2, 5).Resize(Cells(1, 5).End(4).Row - 1, 1).Value
- For i1 = 1 To UBound(arr1, 1)
- For i2 = 1 To UBound(arr2, 1)
- If Right$(arr1(i1, 1), 2) = Left$(arr2(i2, 1), 2) Then
- For i3 = 1 To UBound(arr3, 1)
- If Right$(arr2(i2, 1), 2) = Left$(arr3(i3, 1), 2) Then
- For i4 = 1 To UBound(arr4, 1)
- If Right$(arr3(i3, 1), 2) = Left$(arr4(i4, 1), 2) Then
- For i5 = 1 To UBound(arr5, 1)
- If Right$(arr4(i4, 1), 2) = Left$(arr5(i5, 1), 2) Then
- str1 = "'" & arr1(i1, 1) & Mid$(arr3(i3, 1), 1, 1) & arr5(i5, 1)
- If Not dic.exists(str1) Then
- dic.Add str1, ""
- End If
- End If
- Next i5
- End If
- Next i4
- End If
- Next i3
- End If
- Next i2
- Next i1
- Range("G:G").ClearContents
- If dic.Count > 0 Then
- Range("g1") = dic.Count & "注"
- Range("g2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
- End If
- Set dic = Nothing
- End Sub
具体示例文件如下：
|