1

Column Aの指定された単語のリストからColumn 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. 1 つの値をランダムに選択します (例: A5)
  3. A5B1列にある
  4. 範囲を選択A1:A4 and A6:A20
  5. 1 つの値をランダムに選択します (例: A7)
  6. A7B2列にある
  7. などを繰り返します。
4

3 に答える 3

3

これは思ったよりもトリッキーでした。式は垂直配列として使用する必要があります。出力したいセルを選択し、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
于 2013-07-24T06:28:27.273 に答える
2

2つの追加の列を使用し、VBAコードを使用しない方法は次のとおりです...

あいうえお
単語リスト Rand ランク 15 単語
アップル =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 に答える