1-90个数字，选7

771219

求助大大，各位大大辛苦了，拜托

gwjkkkkk

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub cmdBegin_Click()
    Dim ar, br, strJoin$, dic As Object
   
        Set dic = CreateObject("Scripting.Dictionary")
        If cmdBegin.Caption = "抽取" Then
            cmdBegin.Caption = "停止"
            cmdBegin.ForeColor = 255
        Do While cmdBegin.Caption = "停止"
            ar = RndNumCount(1, 90, 7)
            br = ar
            countSort1 ar
            strJoin = Join(ar, "|")
            If Not dic.Exists(strJoin) Then
                [A1].Resize(, 7) = br
                dic(strJoin) = Empty
            End If
            Sleep 100
            DoEvents
        Loop
    Else
        cmdBegin.ForeColor = 0
        cmdBegin.Caption = "抽取"
    End If
End Sub
Function RndNumCount(MinNum&, MaxNum&, CountNum&)
    Dim i&, n&, ar, xNum&, temp&
    Application.Volatile
    If MaxNum < MinNum Then temp = MaxNum: MaxNum = MinNum: MinNum = temp
    If CountNum > MaxNum - MinNum + 1 Then RndNumCount = "无解": Exit Function
    ReDim ar(1 To CountNum): n = 1
    Randomize
    Do While n <= CountNum
        xNum = Int((MaxNum - MinNum + 1) * Rnd + MinNum)
        ar(n) = xNum
        For i = 1 To n
            If ar(i) = xNum Then Exit For
        Next i
        If i = n Then n = n + 1
    Loop
    RndNumCount = ar
End Function
Function countSort1(ar, Optional order As Boolean = True)
    Dim br, i&, j&, iMin&, iMax&, r&, iBegin&, iEnd&, iStep&
    iMin = Application.Min(ar)
    iMax = Application.Max(ar)
    ReDim br(iMin To iMax)
    For i = LBound(ar) To UBound(ar)
        br(ar(i)) = br(ar(i)) + 1
    Next
    If order Then
        iBegin = LBound(br): iEnd = UBound(br): iStep = 1
    Else
        iBegin = UBound(br): iEnd = LBound(br): iStep = -1
    End If
    r = LBound(ar) - 1
    For i = iBegin To iEnd Step iStep
        If br(i) > 0 Then
            For j = 1 To br(i)
                r = r + 1
                ar(r) = i
            Next j
        End If
    Next i
End Function

gwjkkkkk

用按钮做了一个。。。

771219

gwjkkkkk 发表于 2024-12-21 15:03
用按钮做了一个。。。

谢谢大大的帮助，(Range("h1"))的条件是随着1-7单元格变化产生的，能加入代码中么。在为False时运行，在True时停止

gwjkkkkk

不会了。。。

771219

还是谢谢大大，辛苦了哦

micch

每次生成新的数字输出，就加一句IF判断H1的值呗

771219

micch 发表于 2024-12-21 19:04
每次生成新的数字输出，就加一句IF判断H1的值呗

我不会，能麻烦大大给加上么