こんにちは〜ららぽてすらです♪
会社で1000人から30人抽出するVBA作ったので紹介します😉
住所、電話番号、契約者番号…いろんな情報を抽出する必要があったのでそこはアレンジしてカスタムしてね☺️
Sub RandomExtraction()
Dim rng As Range
Dim i As Integer, RandRow As Integer, LastRow As Integer
Dim RandNums(1 To 30) As Integer
Dim ExtractedData As Range
Application.ScreenUpdating = False
' J列から1083行までのデータが入っているとする
LastRow = 1000
' 30個の重複しない乱数を生成
For i = 1 To 30
Do
RandRow = Int*1 Then
RandNums(i) = RandRow
Exit Do
End If
Loop
Next i
' J列から30名を抽出し、関連データを各列に配置
For i = 1 To 30
Sheets("Sheet1").Cells(i + 1, "AC").Value = Sheets("Sheet1").Cells(RandNums(i), "J").Value ' Names to AC
Sheets("Sheet1").Cells(i + 1, "AD").Value = Sheets("Sheet1").Cells(RandNums(i), "K").Value ' Data from K to AD
Sheets("Sheet1").Cells(i + 1, "AE").Value = Sheets("Sheet1").Cells(RandNums(i), "Y").Value ' Data from Y to AE
Sheets("Sheet1").Cells(i + 1, "AF").Value = Sheets("Sheet1").Cells(RandNums(i), "Z").Value ' Data from Z to AF
Sheets("Sheet1").Cells(i + 1, "AG").Value = Sheets("Sheet1").Cells(RandNums(i), "U").Value ' Data from U to AG
Sheets("Sheet1").Cells(i + 1, "AH").Value = Sheets("Sheet1").Cells(RandNums(i), "V").Value ' Data from V to AH
Sheets("Sheet1").Cells(i + 1, "AI").Value = Sheets("Sheet1").Cells(RandNums(i), "W").Value ' Data from W to AI
Sheets("Sheet1").Cells(i + 1, "AJ").Value = Sheets("Sheet1").Cells(RandNums(i), "X").Value ' Data from X to AJ
Sheets("Sheet1").Cells(i + 1, "AK").Value = Sheets("Sheet1").Cells(RandNums(i), "Y").Value ' Data from Y to AK
Next i
Application.ScreenUpdating = True
End Sub
⭐️解説⭐️
このVBAプログラムは、Excelのシート（"Sheet1"）からランダムに30行を選択し、それらの行から特定の列のデータを抽出し、新たな列にコピーするものです。
以下に、プログラムの各行の説明を行います：
- Sub RandomExtraction() - VBAマクロ（手続き）の開始です。このマクロは「RandomExtraction」という名前です。
- Dim rng As Range - 'rng'という名前のRangeオブジェクトの変数を宣言します。しかし、このプログラムではこの変数は使われていません。
- Dim i As Integer, RandRow As Integer, LastRow As Integer - i、RandRow、LastRowという3つの整数型の変数を宣言します。これらは後でループカウンターや行のインデックス、最終行を示す値として使用されます。
- Dim RandNums(1 To 30) As Integer - 1から30までの整数型の配列RandNumsを宣言します。これにより、生成されたランダムな行のインデックスを保存します。
- Dim ExtractedData As Range - 'ExtractedData'という名前のRangeオブジェクトの変数を宣言します。しかし、このプログラムではこの変数は使われていません。
- Application.ScreenUpdating = False - スクリーンの更新を一時停止します。これにより、処理速度が向上します。
- LastRow = 1083 - 最終行を示す変数（LastRow）に値1083を代入します。J列のデータが1行から1083行まで存在すると仮定しています。
8-14. For i = 1 To 30...Next i - これらの行は30個の重複しない乱数を生成するループです。生成された乱数は1からLastRow（1083）の間であり、RandNums配列に保存されます。
- RandRow = Int*2 Then - この行は、RandRowの値が既にRandNums配列内に存在するかどうかをチェックします。
- RandNums(i) = RandRow - チェックがパスした場合（つまり、RandRowの値が配列内に存在しない場合）、新たな乱数をRandNums配列に追加します。
15-24. For i = 1 To 30...Next i - これらの行は、生成されたランダムな行（RandNums配列に保存された）からデータを抽出し、新たな列に配置するループです。
16-24. Sheets("Sheet1").Cells(i + 1, "AC").Value = Sheets("Sheet1").Cells(RandNums(i), "J").Value など- これらの行は、各ランダム行から特定の列（"J", "K", "Y"など）の値を取得し、新たな列（"AC", "AD", "AE"など）に配置します。
- Application.ScreenUpdating = True - スクリーンの更新を再開します。
- End Sub - この手続き（マクロ）の終わりを示します。
 |
有機 あずき美人茶 ペットボトル 500mL 12本セット【送料無料】【有機JAS認定】 価格:3,240円 |
 |
《2000円クーポン配布中》 ヤ−マン アセチノ5Dデザイニングクリーム 35g ボディクリーム 美容クリーム スキンケア アセチノクリーム アセチノ美容クリーム 価格:3,980円 |
