エクセルのマクロや関数について、ランダムに抽出する方法を探しています

Question

エクセルのマクロや関数について、ランダムに抽出する方法を探しています。

例えばシート1のA列には
1：かっこいい
2：レザー
3：男性用
４：カラー豊富
5：手帳型
6：シンプル
7：～
と言ったよう文字列があり

同じシート1のB列には
1：かわいい
2：花柄
3：カラー豊富
4：レザー
5：手帳型
6：クロコダイル調
7：～

といったような文字が各セルに入力されているとします。
それぞれの列の１行目はテーマのようになっていて
これをシート２で　「かっこいい」を選択してマクロボタンを押したり関数などで
シート１の文字列からランダムで「かっこいい」の列のワードを３つとか４つピックアップして
シート２でかっこいいを選択した横のセルなどに表示させたいのです。

とても分かりにくくて申し訳無いのですが、
テーマに沿ったキーワードが大量にあり、
別シートにてテーマを選択するとそのテーマに沿ったキーワードが複数ピックアップされるような仕組みを模索しています。


もしお分かりになる方、なにかヒント的なものでも思いついた方がいればお教えいただければと思います。何卒よろしくお願いいたします。

d-q-t-p · Accepted Answer

> 各列にどんどん無限に足されていくので
Excelの列数自体が有限ですから 無限に増えることはありません。
あまり条件を無駄に広げるのは良くないと思います。

Sub Macro1()
  Dim xKey As String, i As Long, tf As Boolean
  Dim xRng As Range, yRng As Range, y As Range
  Dim lr As Long, lc As Long, ac As Long
  Dim xStr As String
  Const xCnt As Integer = 3 '抽出数

With ThisWorkbook.Worksheets("Sheet2")
    xKey = .Range("A1").Value
    Set yRng = .Range("B1").Resize(, xCnt)
  End With

With ThisWorkbook.Worksheets("Sheet1")
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    tf = False
    For i = 1 To lc
      If .Cells(1, i).Value = xKey Then
        tf = True
        ac = i
        Exit For
      End If
    Next i
    If tf = False Then
      MsgBox "該当するキーワードがありません。", vbCritical
      Exit Sub
    End If
    lr = .Cells(.Rows.Count, ac).End(xlUp).Row
    If lr - 1 <= xCnt Then
      MsgBox "候補が規定数未満です", vbCritical
      Exit Sub
    End If
    Set xRng = .Range(.Cells(2, ac), .Cells(lr, ac))
  End With
  
  For Each y In yRng
    Do
      y = xRng(WorksheetFunction.RandBetween(1, lr))
    Loop Until WorksheetFunction.CountIf(yRng, y) = 1
  Next y
  Set xRng = Nothing: Set yRng = Nothing
End Sub

tom04 · Answer

こんにちは！

＞呼び出す数が１つの場合、複数の場合など分かればと思います。

たくさんのデータを表示する場合、画面を右にスクロールするのも大変ですので、
C列に表示するようにしてみました。
VBAになりますが一例です。
標準モジュールにしています。
↓の画像のように元データはSheet1にあり、Sheet2のA1セルに「テーマ」？を入力しマクロを実行してみてください。

Sub Sample1()
    Dim i As Long, myCnt As Long, lastRow As Long
    Dim wS As Worksheet, c As Range
    Dim myRow As Long, myFlg(2 To 20000) As Boolean
        Set wS = Worksheets("Sheet1")
            With Worksheets("Sheet2")
                If .Range("A1") <> "" Then
                .Range("C:C").ClearContents
                Set c = wS.Rows(1).Find(what:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
                    If Not c Is Nothing Then
                        lastRow = wS.Cells(Rows.Count, c.Column).End(xlUp).Row
                        myCnt = Application.InputBox("表示個数を入力")
                        If lastRow - 1 < myCnt Then
                            MsgBox "表示個数がデータ数を超えています。"
                            Exit Sub
                        End If
                        For i = 1 To myCnt
                            Do
                                myRow = Int((lastRow - 2 + 1) * Rnd + 2)
                            Loop Until myFlg(myRow) = False
                                .Cells(i, "C") = wS.Cells(myRow, c.Column)
                                myFlg(myRow) = True
                        Next i
                    Else
                        MsgBox "該当項目なし"
                    End If
                End If
                End With
End Sub

※　画像は表示個数を「3」としてマクロを実行しました。

これで重複なしにSheet1の2行目以降のデータが表示されると思います。m(_ _)m

yuji3690 · Answer

RANDBETWEENという、ある値以上ある値以下の整数をランダムに表示する関数があります。
例えば、1行目はテーマとし、2～その列の最下データをランダムに指定したい場合、
RANDBETWEEN(2,COUNTA(該当列：該当列))
で、2~該当列にあるデータの数でランダムな数値が取得できます。
（データは上詰めで空白が無いものとします）

該当列の表示については、INDIRECTとMATCHとADDRESSを使います。
MATCH(表示するテーマの入力されたセル,1:1,FALSE)
これで、1行目の中から入力されたテーマと一致するセルを検索し、その列番号を取得できます。
ADDRESS(1,列番号)
これにより、その列番号の1行目のセルのセル番地(A1など)を取得できます。
1としているのは、とりあえず行番号を1としているだけです。
このセル番地をアドとして次の式に書きます。（先ほどのセル番地、と書くと長いので）
INDIRECT(LEFT(アド,LEN(アド)-1)&":"&LEFT(アド,LEN(アド)-1))
LENで文字数を確認し、LEFT(,LEN-1)で、アドの右端1文字を除いたデータを取得しています。
右端1文字とは、先ほどの1です。列名を取得する為に行番号を1桁に固定し、その部分を除外しているということです。
これによって「該当列：該当列」を指定できました。

ここまでをまとめると
=RANDBETWEEN(2,COUNTA(INDIRECT(LEFT(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)),LEN(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)))-1)&":"&LEFT(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)),LEN(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)))-1))))
これによってランダムに行番号の指定ができました。
これを用いて、そのテーマの、この行番号のセルにあるデータを表示させる必要があります。

先ほど同様に
INDIRECT(LEFT(アド,LEN(アド)-1)&行番号)
とすることで、テーマの列の行番号にあるセルのデータを取得できます。

では先ほどの行番号の式とアドの式を入れましょう。
=INDIRECT(LEFT(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)),LEN(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)))-1)&RANDBETWEEN(2,COUNTA(INDIRECT(LEFT(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)),LEN(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)))-1)&":"&LEFT(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)),LEN(ADDRESS(1,MATCH(表示するテーマの入力されたセル,1:1,FALSE)))-1)))))

「表示するテーマの入力されたセル」というのは具体的にセルを指定してくださいね。

これで一応完成なのですが、1つだけ問題が。
複数ランダムで表示させた時に、同じものが複数選ばれる可能性が残ります。
これはキーワードが100万だろうが1兆だろうが、可能性としてはありえるのです。
どうしても重複は避けたいのであれば、何かしらの方法は考えますが、非常に手間だったり、重くなるかもしれません。（当然テーマに該当するキーワードの数や、抽出する個数によっても変わります）

とりあえずここまで。

d-q-t-p · Answer

ryo_kyさんの方法はご本人も書いていらっしゃる通り 重複に対応しないので多分
そもそもダメなんじゃないかと思いますが 四捨五入してしまうと丸め誤差が出て
しまうので 最低でも切り捨てた方がいいと思います。

d-q-t-p · Answer

> ワードを３つとか４つピックアップして
呼び出す数自体もランダムにする必要があるのですか？

実際にはどのくらいのデータがあるのかも この説明ではよく分かりません。

ryo_ky · Answer

ヒントで良いなら，
2行目以降の数値であるなら2～xまでの値が入れば良いので例えばA2～A11の範囲（ワードが10個）なら
=ROUND(RAND()*10,0)
という関数で0～9の数値がランダムに出す事が可能です．
※RAND関数は0以上1未満を返す関数です．
　ROUND関数は四捨五入の関数で後ろ数値はどの桁で四捨五入するかを示します．

INDEX関数と組み合わせれば
=INDEX(A2:A11,ROUND(RAND()*10,0),1)

これを3つ4つのセルに入れておけばランダムでワードが選択されます．
※但し重複する可能性もあります．

エクセルのマクロや関数について、ランダムに抽出する方法を探しています

> 各列にどんどん無限に足されていくので

こんにちは！

RANDBETWEENという、ある値以上ある値以下の整数をランダムに表示する関数があります。

ryo_kyさんの方法はご本人も書いていらっしゃる通り 重複に対応しないので多分

> ワードを３つとか４つピックアップして

ヒントで良いなら，

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

ryo_kyさんの方法はご本人も書いていらっしゃる通り重複に対応しないので多分