vba 在 Excel 中生成随机单词列表，但没有重复

Generating a list of random words in Excel, but no duplicates

提问by Kyle Yeo

I'm trying to generate words in Column Bfrom a list of given words in Column A.

我试图生成字列B从给出的单词列表A柱。

Right now my code in Excel VBA does this:

现在我在 Excel VBA 中的代码执行以下操作：

Function GetText()
    Dim GivenWords
    GivenWords = Sheets(1).Range(Sheets(1).[a1], Sheets(1).[a20])
    GetText = A(Application.RandBetween(1, UBound(A)), 1)
End Function

This generates a word from the list I have provided in A1:A20, but I don't want any duplicates.

这会从我在 中提供的列表中生成一个单词A1:A20，但我不想要任何重复项。

GetText()will be run 15 times in Column Bfrom B1:B15.

GetText()将运行在15次列B从B1:B15。

How can I check for any duplicates in Column B, or more efficiently, remove the words temporarily from the list once it has been used?

如何检查 B 列中的任何重复项，或者更有效地，在使用后从列表中临时删除这些词？

For example,

例如，

1. Select Range A1:A20
2. Select one value randomly (e.g A5)
3. A5is in Column B1
4. Select Range A1:A4 and A6:A20
5. Select one value randomly (e.g A7)
6. A7is in Column B2
7. Repeat, etc.

1. 选择范围 A1:A20
2. 随机选择一个值（例如A5）
3. A5在 B1 列中
4. 选择范围 A1:A4 and A6:A20
5. 随机选择一个值（例如A7）
6. A7在 B2 列中
7. 重复等。

回答by RowanC

This was trickier than I thought. The formula should be used as a vertical array eg. select the cells where you want the output, press f2 type =gettext(A1:A20) and press ctrl+shift+enter

这比我想象的要棘手。该公式应用作垂直数组，例如。选择你想要输出的单元格，按 f2 type =gettext(A1:A20) 然后按 ctrl+shift+enter

This means that you can select where your input words are in the worksheet, and the output can be upto as long as that list of inputs, at which point you'll start getting #N/A errors.

这意味着您可以选择输入词在工作表中的位置，并且输出可以与输入列表一样长，此时您将开始收到 #N/A 错误。

Function GetText(GivenWords as range)
    Dim item As Variant
    Dim list As New Collection
    Dim Aoutput() As Variant
    Dim tempIndex As Integer
    Dim x As Integer

    ReDim Aoutput(GivenWords.Count - 1) As Variant
    For Each item In GivenWords
        list.Add (item.Value)
    Next
    For x = 0 To GivenWords.Count - 1
        tempIndex = Int(Rnd() * list.Count + 1)
        Aoutput(x) = list(tempIndex)
        list.Remove tempIndex
    Next

    GetText = Application.WorksheetFunction.Transpose(Aoutput())
End Function

回答by SeanC

Here's how I would do it, using 2 extra columns, and no VBA code...

这是我将如何做到这一点，使用 2 个额外的列，并且没有 VBA 代码......

A              B        C                    D
List of words  Rand     Rank                 15 Words
Apple          =RAND()  =RANK(B2,$B:$B) =INDEX($A:$A,MATCH(ROW()-1,$C:$C,0))

copy B2 and C2 down as far as the list, and drag D down for however many words you want.

将 B2 和 C2 向下复制到列表中，然后将 D 向下拖动以获取您想要的任意数量的单词。

Copy the word list somewhere, as every time you change something on the sheet (or recalculate), you will get a new list of words

将单词列表复制到某处，因为每次更改工作表上的某些内容（或重新计算）时，您都会得到一个新的单词列表

Using VBA:

使用 VBA：

Sub GetWords()
Dim Words
Dim Used(20) As Boolean
Dim NumChosen As Integer
Dim RandWord As Integer

Words = [A1:A20]

NumChosen = 0

While NumChosen < 15
    RandWord = Int(Rnd * 20) + 1
    If Not Used(RandWord) Then
        NumChosen = NumChosen + 1
        Used(RandWord) = True
        Cells(NumChosen, 2) = Words(RandWord, 1)
    End If
Wend
End Sub

回答by Bharath Raja

Here is the code. I am deleting the cell after using it. Please make a backup of your data before using this as it will delete the cell contents (it will not save automatically...but just in case). You need to run the 'main' sub to get the output.

这是代码。我正在使用它后删除该单元格。请在使用之前备份您的数据，因为它会删除单元格内容（它不会自动保存......但以防万一）。您需要运行 'main' sub 以获取输出。

Sub main()
  Dim i As Integer
  'as you have put 15 in your question, i am using 15 here. Change it as per your need.
   For i = 15 To 1 Step -1
     'putting the value of the function in column b (upwards)
     Sheets(1).Cells(i, 2).Value = GetText(i)
   Next
End Sub

Function GetText(noofrows As Integer)
  'if noofrows is 1, the rand function wont work
   If noofrows > 1 Then
     Dim GivenWords
     Dim rowused As Integer
     GivenWords = Sheets(1).Range(Sheets(1).Range("A1"), Sheets(1).Range("A" & noofrows))

    'getting the randbetween value to a variable bcause after taking the value, we can delete the cell.
     rowused = (Application.RandBetween(1, UBound(GivenWords)))
     GetText = Sheets(1).Range("A" & rowused)

     Application.DisplayAlerts = False
     'deleting the cell as we have used it and the function should not use it again
     Sheets(1).Cells(rowused, 1).Delete (xlUp)
     Application.DisplayAlerts = True
   Else
    'if noofrows is 1, there is only one value left. so we just use it.
    GetText = Sheets(1).Range("A1").Value
    Sheets(1).Cells(1, 1).Delete (xlUp)
   End If
End Function

Hope this helps.

希望这可以帮助。