我用BVA做的彩票摇珠程序

alex1437

分享一下我做的彩票摇珠程序

alex1437

忘了上传附件，不好意思。

jhcyg8

?????????????????????????????????????????????????????????????

alex1437

应该没问题的，你再试下。

jiliyacui

····顶!    谢谢你的无私分享

xsfhlzh

我这用不了，不过把以前写的子程代替就可以了，版本的问题？
另外If语句看的好累

Private Sub CommandButton1_Click()
    Dim n As Integer
    arr = GetRndNotRepeat(1, 49, 7)
    For x = 1 To 7
        n = arr(x - 1)
        If x = 7 Then x = 8
        Cells(1, x) = n
        Cells(1, x).Font.ColorIndex = GetColorIndex(n)
    Next
End Sub

Public Function GetColorIndex(ByVal n As Integer) As Integer
    Select Case n
    Case 1, 2, 7, 8, 12, 13, 18, 19, 23, 24, 29, 30, 34, 35, 40, 45, 49
        GetColorIndex = 3
    Case 3, 4, 9, 10, 14, 15, 20, 25, 26, 31, 36, 37, 41, 42, 47, 48
        GetColorIndex = 5
    Case Else
        GetColorIndex = 10
    End Select
End Function

Public Function GetRndNotRepeat(ByVal NumMin As Integer, ByVal NumMax As Integer, ByVal n As Integer)
'编制:xsfhlzh
'功能:取NumMin到NumMax间的n个随机整数
    If n > NumMax - NumMin + 1 Then Exit Function
    Dim arr()
    ReDim arr(n - 1)
    Dim b() As Boolean
    ReDim b(NumMax - NumMin) '取数标志
    Dim x As Integer, y As Integer
    Randomize
    For i = 0 To n - 1
        Do '找到x的位置，y表示x在取数标志数组的位置
            x = Int(Rnd * (NumMax - NumMin + 1)) + NumMin
            y = x - NumMin
        Loop While b(y)
        b(y) = True
        arr(i) = x '找到未取的数，并放入数组，设置标志位
    Next i
    GetRndNotRepeat = arr
End Function

alex1437

谢谢分享。。。。。。。。。

jhonsun

十分感谢！！！

ericfei

楼主用这个工具中过奖没？