楼主
liuguansky |
Q：[彩票]如何返回落号重新组合三位数中出现次数前三的号码？
A:用如下代码可以实现：
- Sub juesttest()
- Dim arr, i%, j%, str1$, dic, k%, arrt(), m%, n%, str2$, d, arrs, arrre1(), arrre2(), arrre3(), s1%, s2%, s3%
- Set dic = CreateObject("scripting.dictionary")
- arr = [d475:M541]
- For i = 1 To UBound(arr, 1) - 1
- str1 = ""
- For j = 1 To UBound(arr, 2)
- If arr(i, j) = arr(i + 1, j) Then
- str1 = str1 & arr(i, j)
- End If
- Next j
- k = 0
- For j = 1 To 9
- If InStr(1, str1, j) > 0 Then
- k = k + 1
- ReDim Preserve arrt(1 To k)
- arrt(k) = j
- End If
- Next j
- If k >= 3 Then
- For j = 1 To k - 2
- For m = j + 1 To k - 1
- For n = m + 1 To k
- str2 = j & m & n
- If dic.exists(str2) Then
- dic(str2) = dic(str2) + 1
- Else: dic.Add str2, 1
- End If
- Next n, m, j
- End If
- Next i
- If dic.Count > 0 Then
- s = 0
- arrs = dic.items
- For Each d In dic.keys
- Select Case dic(d)
- Case Application.Large(arrs, 1)
- s1 = s1 + 1
- ReDim Preserve arrre1(1 To s1)
- arrre1(s1) = d
- Case Application.Large(arrs, 2)
- s2 = s2 + 1
- ReDim Preserve arrre2(1 To s2)
- arrre2(s2) = d
- Case Application.Large(arrs, 3)
- s3 = s3 + 1
- ReDim Preserve arrre3(1 To s3)
- arrre3(s3) = d
- Case Else
- End Select
- Next d
- MsgBox "落号组合第一的三位数是" & Join(arrre1, ",") & vbCrLf & _
- "落号组合第二的三位数是" & Join(arrre2, ",") & vbCrLf & _
- "落号组合第三的三位数是" & Join(arrre3, ",")
- Else: MsgBox "未有落号产生"
- End If
- Set dic = Nothing
- End Sub
|