双色球中奖查询程序

 

Sub Chaxun()
Const mycaipiao = "01 03 05 07 09 15 29 24 27 33+02 07 09 13 16"
jisuan "08119", mycaipiao
End Sub
Sub jiangjin(a, b, c, d, j1, j2, result As String)
Dim x(6), i As Long
s = Split("投注金额 一等奖 二等奖 三等奖 四等奖 五等奖 六等奖")
x(0) = Comp(a, 6) * b
x(1) = Comp(c, 6) * d
x(2) = Comp(c, 6) * (b - d)
x(3) = Comp(c, 5) * (a - c)
x(4) = Comp(c, 4) * d * Comp(a - c, 2) + (b - d) * (a - c) * Comp(c, 5)
x(5) = Comp(c, 3) * d * Comp(a - c, 3) + (b - d) * Comp(c, 4) * Comp(a - c, 2)
x(6) = Comp(c, 2) * d * Comp(a - c, 4) + c * d * Comp(a - c, 5) + d * Comp(a - c, 6)
result = "中奖金额" & vbTab & x(1) * j1 + x(2) * j2 + x(3) * 3000 + x(4) * 200 + x(5) * 10 + x(6) * 5 & "元"
For i = 0 To 6
x(i) = s(i) & "  " & vbTab & x(i) & "注" & vbTab & vbTab & Array(2, j1, j2, 3000, 200, 10, 5)(i) * x(i) & "元"
Next
result = Join(x, vbCrLf) & vbCrLf & result
End Sub
Function Comp(a, b) As Long
If b = 0 Then Comp = 1
If b = a Then Comp = 1
If a > b And b > 0 Then Comp = Comp(a - 1, b) + Comp(a - 1, b - 1)
End Function
Sub jisuan(ByVal qi As String, ByVal mycaipiao As String, Optional ByRef result As String)
Dim s As String, red As String, blue As String, j1 As Long, j2 As Long, redball() As String, blueball() As String, bb() As String, i As Long
Dim redcount As Long, bluecount As Long
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", "http://www.cpyjy.com/affiche/1_" & qi & ".html", False
.Send
s = .responseText
red = Split(Split(s, "<font color=""#ff0000"">")(1), "<")(0)
blue = Right("0" & Split(Split(s, "<font color=""#0000ff"">")(1), "<")(0), 2)
j1 = Split(Split(s, "<td align=""right"" width=""27%""><font size=""2""><strong>")(2), "<")(0)
j2 = Split(Split(s, "<td align=""right"" width=""27%""><font size=""2""><strong>")(4), "<")(0)
End With

bb = Split(red, ",")
For i = 0 To UBound(bb)
bb(i) = Right("0" & bb(i), 2)
Next
red = Join(bb, " ")

redball = Split(Split(mycaipiao, "+")(0))
For i = 0 To UBound(redball)
If InStr(red, redball(i)) > 0 Then redcount = redcount + 1
Next

blueball = Split(Split(mycaipiao, "+")(1))
For i = 0 To UBound(blueball)
If blueball(i) = blue Then bluecount = 1: Exit For
Next
jiangjin UBound(redball) + 1, UBound(blueball) + 1, redcount, bluecount, j1, j2, result
result = "中奖号码" & vbTab & red & "+" & blue & vbCrLf & "我的投注" & vbTab & mycaipiao & vbCrLf & String(Len(mycaipiao) + 16, "-") & vbCrLf & result
MsgBox result, , "双色球第" & qi & "期"
End Sub