个双色球小程序的代码

yuanlong1980

今天写了一个 双色球小程序代码，现在拿出来分享一下。可以为vba菜鸟提供思路，同时也欢迎大神提意见。
sub 双色球（）
Dim MR As Range
Dim ZD
ZD = Application.Count(Range("B5:G5"))

Range("B2:G2").ClearContents

Do
    xh = xh + 1

        Select Case ZD
            Case 0

                  For Each MR In Range("B2:G2")
                    Do
                    MR = Application.RandBetween(1, 33)
                    Loop Until Application.CountIf(Range("B2:G2"), MR) = 1
                    Next MR

                     Range("B3") = Application.RandBetween(1, 15)

                     With ActiveWorkbook.Worksheets("Sheet2").Sort
                        .SetRange Range("B2:G2")
                        .Apply
                    End With
           Case 1
                  For Each MR In Range("B2:f2")
                    Do
                    MR = Application.RandBetween(1, 33)
                    Loop Until Application.CountIf(Range("B2:f2"), MR) = 1
                    Next MR

                     Range("B3") = Application.RandBetween(1, 15)

                     With ActiveWorkbook.Worksheets("Sheet2").Sort
                        .SetRange Range("B2:f2")
                        .Apply
                     End With
           Case 2

                      For Each MR In Range("B2:E2")
                        Do
                        MR = Application.RandBetween(1, 33)
                        Loop Until Application.CountIf(Range("B2:E2"), MR) = 1
                        Next MR

                         Range("B3") = Application.RandBetween(1, 15)

                         With ActiveWorkbook.Worksheets("Sheet2").Sort
                            .SetRange Range("B2:E2")
                            .Apply
                         End With

           Case 3

                      For Each MR In Range("B2:D2")
                        Do
                        MR = Application.RandBetween(1, 33)
                        Loop Until Application.CountIf(Range("B2:D2"), MR) = 1
                        Next MR

                         Range("B3") = Application.RandBetween(1, 15)

                         With ActiveWorkbook.Worksheets("Sheet2").Sort
                            .SetRange Range("B2:D2")
                            .Apply
                         End With

           Case 4

                      For Each MR In Range("B2:C2")
                        Do
                        MR = Application.RandBetween(1, 33)
                        Loop Until Application.CountIf(Range("B2:C2"), MR) = 1
                        Next MR

                         Range("B3") = Application.RandBetween(1, 15)

                         With ActiveWorkbook.Worksheets("Sheet2").Sort
                            .SetRange Range("B2:C2")
                            .Apply
                         End With

           Case 5

                      For Each MR In Range("B2")
                        Do
                        MR = Application.RandBetween(1, 33)
                        Loop Until Application.CountIf(Range("B2"), MR) = 1
                        Next MR

                         Range("B3") = Application.RandBetween(1, 15)

                         With ActiveWorkbook.Worksheets("Sheet2").Sort
                            .SetRange Range("B2")
                            .Apply
                         End With

       End Select

Range("A2").Select
Loop Until xh = 150

End Sub

yuanlong1980

自己顶下