ゴリラストロングの雑記帳

月収10万円の広告収入を目指す自称専業ライターのブログです。




【VBA】データを重複なしで無作為に抽出するマクロを作成してみました。




どうも、ゴリラストロングです。

 

今回はVBAで、データを重複なしで無作為に抽出するマクロを作成してみました。

 

<元データ>

f:id:gorilla-strong:20200427044924p:plain

 E列にRandBetween関数で無作為にNoを抽出します。

その際、重複の番号があったらエラーメッセージを出します。

エラーメッセージが出ない場合に抽出が完了できます。

 

<マクロ実行後>

f:id:gorilla-strong:20200427045239p:plain

これは重複ありでエラーを出している場合です。

 

f:id:gorilla-strong:20200427045352p:plain

こちらが重複なしで対象者の抽出が完了できている場合です。

 

動作としては以上です。

 

ソースコード 

Sub main()

Dim ws As Object
Set ws = ThisWorkbook.Worksheets(1)

Dim lasatrow As Long
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To 7

ws.Range("E" & i) = WorksheetFunction.RandBetween(1, WorksheetFunction.CountA(ws.Range("B3:B" & lastrow)))

Next


For j = 3 To 7

If Application.CountIf(ws.Range("E3:E7"), ws.Range("E" & j)) > 1 Then
    MsgBox "対象者が重複しています。", vbOKOnly + vbExclamation, "入力エラー"
    Exit Sub
End If

Next

For k = 3 To 7

ws.Range("F" & k) = WorksheetFunction.VLookup(ws.Range("E" & k), ws.Range("A3:C" & lastrow), 2, 0)
ws.Range("G" & k) = WorksheetFunction.VLookup(ws.Range("E" & k), ws.Range("A3:C" & lastrow), 3, 0)

Next

End Sub

 

<参照させていただいたサイト>

https://infith.com/system/excel/countif_find/

 

以上、ゴリラストロングでした。