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

Question

我正在尝试根据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() 将在 B 列 中从 B1:B15 运行 15 次。

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

例如，

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

Answer 1

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

这意味着您可以选择输入单词在工作表中的位置，并且输出可以与输入列表一样长，此时您将开始出现 #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

我会这样做，使用 2 个额外的列，并且没有 VBA 代码...

A B C D 单词列表 Rand Rank 15 Words 苹果 =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

Answer 3

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

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

希望这会有所帮助。