Gerar uma lista de palavras aleatórias no Excel, mas sem duplicados
estou a tentar gerar palavras na coluna B de uma lista de palavras dadas emcoluna a .
Neste momento, o meu código no Excel VBA Faz isto:Function GetText()
Dim GivenWords
GivenWords = Sheets(1).Range(Sheets(1).[a1], Sheets(1).[a20])
GetText = A(Application.RandBetween(1, UBound(A)), 1)
End Function
isto gera uma palavra da lista que eu forneci em A1:A20, mas não quero duplicados .
GetText() será executado 15 vezes emcoluna B de B1:B15.
Como posso verificar quaisquer duplicados na coluna B, ou de forma mais eficiente, remover as palavras temporariamente de a lista depois de ter sido usada?
por exemplo,
- Seleccione O Intervalo
A1:A20 - seleccione um valor aleatoriamente (p. ex.
A5) -
A5está na coluna B1 - Seleccione O Intervalo
A1:A4 and A6:A20 - seleccione um valor aleatoriamente (p. ex.
A7) -
A7está na coluna B2 - repetir, etc.
3 answers
Isto significa que você pode seleccionar onde as suas palavras de entrada estão na folha de trabalho, e a saída pode ser até essa lista de entradas, altura em que você vai começar a obter erros #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
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
Aqui está como eu faria isso, usando 2 colunas extras, e sem código 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))
Copiar B2 E C2 para baixo até à lista, e arrastar D para baixo para Quantas palavras quiser.
Copie a lista de Palavras em algum lugar, porque sempre que mudar alguma coisa na folha (ou recalcular), irá obter uma nova lista de palavras
Usando 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