1

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

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

例如，

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

3 回答 3

3

这比我想象的要棘手。该公式应用作垂直数组，例如。选择要输出的单元格，按 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
于 2013-07-24T06:28:27.273 回答
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
于 2013-07-24T14:11:55.910 回答
0

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

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

希望这可以帮助。

于 2013-07-24T06:17:26.250 回答