使用Excel宏更好地随机，无重复，按顺序[重复]

Question

我在这个项目上工作了一段时间，并在整个过程中得到了各种帮助（多年没有接触过代码）

我正在创建一个彩票生成器，我终于快完成了，但是我的随机需要一些工作，我想按升序显示数字并用连字符分隔，如下例所示括号：“12-16-24”

目前，我的代码将一个不同的随机数 (1-24) 放在一行中的三列中，并重复执行直到循环完成。代码应将列最小化为 1 个“彩票”列，而不是 3 个。

任何想法，我该怎么做？我当前要遵循的代码：

Sub New_Entry()
  Dim strPlayer As String, strTick As Integer, i As Integer, j As Integer
  strPlayer = InputBox("Input Player Name")
  strTick = InputBox("How many tickets?")
  i = Cells(Rows.Count, 1).End(xlUp).Row + 1
  For i = i To i + strTick - 1
    Cells(i, 1).Value = strPlayer
    For j = 2 To 4
      Cells(i, j).Value = Int((24 - 1 + 1) * Rnd + 1)
    Next j
  Next i
End Sub

Answer 1

以下内容可能会对您有所帮助：

Function LotteryTicket() As String
    Dim i As Long
    Dim nums(1 To 3) As Integer
    Dim A(1 To 3) As Variant

    With Application.WorksheetFunction
        Do While True
            For i = 1 To 3
                nums(i) = .RandBetween(1, 24)
            Next i
            For i = 1 To 3
                A(i) = .Small(nums, i)
            Next i
            If A(1) <> A(2) And A(2) <> A(3) Then
                LotteryTicket = Join(A, "-")
                Exit Function
            End If
        Loop
    End With

End Function

它使用简单的偶然发现方法来获取不同的数字。 1-24 中随机选择的 3 个数字不同的概率为 P(24,3)/24^3 = 87.8%，因此通过外循环的预期运行次数小于 2。

这样测试：

Sub test()
    Dim i As Long
    For i = 1 To 10
        Cells(I,1).Value = LotteryTicket()
    Next i
End Sub

运行后的输出如下所示（假设单元格被格式化为文本，因此 Excel 不会将内容解释为日期）：

1-7-10
1-17-23
8-14-15
8-12-24
2-14-17
4-7-14
5-6-23
16-20-21
4-10-24
6-11-15

Answer 2

如果您不想重复，只需测试数字是否已经在数组中，如果为真，则计算一个新的随机数（此代码是为 6 个中奖号码编写的）：

Sub New_Entry()
Dim strPlayer As String, strTick As Integer, i As Integer, j As Integer
Dim win_tkt As Variant
Dim number_to_find As Integer
 strPlayer = InputBox("Input Player Name")
 strTick = InputBox("How many tickets?")

  ReDim win_tkt(5) 'how many numbers are extracted -1
  i = Cells(Rows.Count, 1).End(xlUp).Row + 1
  For i = i To i + strTick - 1
    Cells(i, 1).Value = strPlayer

    win_tkt(0) = Int((24 - 1 + 1) * Rnd + 1)
    For j = 2 To 6 'from 2nd winning number to last winning number
      number_to_find = Int((24 - 1 + 1) * Rnd + 1)
      Do While IsInArray(number_to_find, win_tkt) = True
            number_to_find = Int((24 - 1 + 1) * Rnd + 1)
       Loop
       win_tkt(j - 1) = number_to_find

    Next j
      Call sort_array(win_tkt)
    Cells(i, 2).Value = Join(win_tkt, "-")
  Next i
End Sub

Function IsInArray(find_number As Integer, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, find_number)) > -1)
End Function

Sub sort_array(arr As Variant)
    Dim strTemp As String
    Dim i As Long
    Dim j As Long
    Dim lngMin As Long
    Dim lngMax As Long
    lngMin = LBound(arr)
    lngMax = UBound(arr)
    For i = lngMin To lngMax - 1
      For j = i + 1 To lngMax
        If arr(i) > arr(j) Then
          strTemp = arr(i)
          arr(i) = arr(j)
          arr(j) = strTemp
        End If
      Next j
    Next i
End Sub