我如何随机select一些单元格并在消息框中显示内容？

我有单元格A1-A37中的ID号1101-1137的列表。 我想单击一个button来随机select其中的20个，不重复，并显示在消息框中。

我现在所拥有的似乎是从数字1-37中随机select，而不是细胞的实际内容，我不知道如何解决这个问题。 例如，如果我删除单元格A37中的数字1137，数字37仍然可以在消息框中结束; 如果我用字母Ereplace单元格A5中的数字1105，E将不会显示在消息框中，但是5可以。

但是，如果我将“Const nItemsTotal As Long = 37”更改为等于某个其他数字（如31），则它将仅输出1-31的数字。

这是我的：

Private Sub CommandButton1_Click() Const nItemsToPick As Long = 20 Const nItemsTotal As Long = 37 Dim rngList As Range Dim idx() As Long Dim varRandomItems() As Variant Dim i As Long Dim j As Long Dim booIndexIsUnique As Boolean Set rngList = Range("A1").Resize(nItemsTotal, 1) ReDim idx(1 To nItemsToPick) ReDim varRandomItems(1 To nItemsToPick) For i = 1 To nItemsToPick Do booIndexIsUnique = True ' Innocent until proven guilty idx(i) = Int(nItemsTotal * Rnd + 1) For j = 1 To i - 1 If idx(i) = idx(j) Then ' It's already there. booIndexIsUnique = False Exit For End If Next j If booIndexIsUnique = True Then strString = strString & vbCrLf & idx(i) Exit Do End If Loop varRandomItems(i) = rngList.Cells(idx(i), 1) Next i Msg = strString MsgBox Msg ' varRandomItems now contains nItemsToPick unique random ' items from range rngList. End Sub 

我确定这是一个愚蠢的错误，但我迷路了。 非常感谢你的帮助。

Answer 1

我已经在代码中添加了一行…现在是：

 strString = strString & vbCrLf & Cells(idx(i), 1).Value 

完整的代码是：

 Private Sub CommandButton1_Click() Const nItemsToPick As Long = 20 Const nItemsTotal As Long = 37 Dim rngList As Range Dim idx() As Long Dim varRandomItems() As Variant Dim i As Long Dim j As Long Dim booIndexIsUnique As Boolean Set rngList = Range("A1").Resize(nItemsTotal, 1) ReDim idx(1 To nItemsToPick) ReDim varRandomItems(1 To nItemsToPick) For i = 1 To nItemsToPick Do booIndexIsUnique = True ' Innocent until proven guilty idx(i) = Int(nItemsTotal * Rnd + 1) For j = 1 To i - 1 If idx(i) = idx(j) Then ' It's already there. booIndexIsUnique = False Exit For End If Next j If booIndexIsUnique = True Then strString = strString & vbCrLf & Cells(idx(i), 1).Value Exit Do End If Loop varRandomItems(i) = rngList.Cells(idx(i), 1) Next i Msg = strString MsgBox Msg ' varRandomItems now contains nItemsToPick unique random ' items from range rngList. End Sub 

因此，不是返回数字，而是使用返回的数字来查看与其相关的行上的值。

Answer 2

如果你构造一个包含已经通过随机发现的ID的string，你可以检查重复。

 Dim i As Long, msg As String, id As String msg = Chr(9) For i = 1 To 20 id = 1100 + Int((37 - 1 + 1) * Rnd + 1) Do Until Not CBool(InStr(1, msg, Chr(9) & id & Chr(9))) Debug.Print id & msg id = 1100 + Int((37 - 1 + 1) * Rnd + 1) Loop msg = msg & id & Chr(9) Next i msg = Mid(Left(msg, Len(msg) - 1), 2) MsgBox msg 

Answer 3

只要洗牌指数 ：

 Sub MAIN() Dim ary(1 To 37) As Variant Dim i As Long, j As Long For i = 1 To 37 ary(i) = i Next i Call Shuffle(ary) msg = "" For i = 1 To 20 j = ary(i) msg = msg & vbCrLf & Cells(j, 1).Value Next i MsgBox msg End Sub Public Sub Shuffle(InOut() As Variant) Dim i As Long, j As Long Dim tempF As Double, Temp As Variant Hi = UBound(InOut) Low = LBound(InOut) ReDim Helper(Low To Hi) As Double Randomize For i = Low To Hi Helper(i) = Rnd Next i j = (Hi - Low + 1) \ 2 Do While j > 0 For i = Low To Hi - j If Helper(i) > Helper(i + j) Then tempF = Helper(i) Helper(i) = Helper(i + j) Helper(i + j) = tempF Temp = InOut(i) InOut(i) = InOut(i + j) InOut(i + j) = Temp End If Next i For i = Hi - j To Low Step -1 If Helper(i) > Helper(i + j) Then tempF = Helper(i) Helper(i) = Helper(i + j) Helper(i + j) = tempF Temp = InOut(i) InOut(i) = InOut(i + j) InOut(i + j) = Temp End If Next i j = j \ 2 Loop End Sub 

Answer 4

另一种方法：

 Sub test() Dim Dic As Object, i% Set Dic = CreateObject("Scripting.Dictionary") Dic.comparemode = vbTextCompare While Dic.Count <> 20 i = WorksheetFunction.RandBetween(1, 37) If Not Dic.exists(i) Then Dic.Add i, Cells(i, "A") Wend MsgBox Join(Dic.Items, Chr(13)) End Sub 

testing：

---