在Excel中生成随机单词列表，但不重复

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

现在我在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 

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

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

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

例如，

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

Answer 1

这比我想象的更复杂。 该公式应该用作垂直数组，例如。 select你想输出的单元格，按f2 type = gettext（A1：A20），然后按ctrl + shift + enter

这意味着您可以selectinput单词在工作表中的位置，输出可以达到与input列表一样长的时间，此时您将开始获得＃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 

Answer 2

这是代码。 我正在使用它删除单元格。 请在使用前备份您的数据，因为它会删除单元格内容（它不会自动保存…但以防万一）。 你需要运行'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 

希望这可以帮助。

Answer 3

下面是我将如何做，使用2个额外的列，并没有VBA代码…

 A B C D
兰德等级15字的列表
 Apple = RAND（）= RANK（B2，$ B $ 2：$ B $ 21）= INDEX（$ A $ 2：$ A $ 21，MATCH（ROW（） -  1，$ C $ 2：$ C $ 21,0））

将B2和C2复制到列表中，然后向下拖动D以获得所需的多个单词。

将单词列表复制到某个地方，因为每次在表格上更改某个内容（或重新计算）时，都会得到一个新的单词列表

使用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