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()将在B1:B15的 B列中运行15次。

我如何检查B列中的任何重复项，或者更有效率，一旦使用它就暂时从列表中删除这些单词？

例如，

选择范围A1:A20
随机选择一个值（例如A5）
A5位于B1栏
选择范围A1:A4 and A6:A20
随机选择一个值（例如A7）
A7位于第B2栏
重复等

Answer 1

这比我想象的要复杂。公式应该用作垂直数组，例如。选择要输出的单元格，按f2 type = 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
List of words  Rand     Rank                 15 Words
Apple          =RAND()  =RANK(B2,$B$2:$B$21) =INDEX($A$2:$A$21,MATCH(ROW()-1,$C$2:$C$21,0))

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

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

Example

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

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

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

希望这有帮助。

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

3 个答案: