【ExcelVBAマクロ備忘録】セルに記載された数値分繰り返し処理するサンプル

ExcelVBAマクロの備忘録です。
特定のデータ群があり、そのうちのセルに書かれた数値の数だけ、1レコード毎ずつ繰り返し処理して別シートに出力したいというマニアックな要望に対しての備忘録です。VBAに慣れている方からは難しくないですが、汎用的な記事があまり無かったので記載しておきます。

利用用途の例

用途として、通販サイトや会員サービスにおいて、注文点数／利用回数分／キャンペーン達成回数などの数値分だけ、ユニークなクーポンコード／キャンペーンコードなどを発行したい時などに利用します。このマクロの後、【CSV流し込み】などを行う想定です。

Excelシートイメージ

Excelシートがあり、
・「Sheet1」には、注文番号、注文点数、顧客IDが入っているとします。
・「シリアル」シート（結果を書き出すシート）に、
　注文回数分、注文番号一覧を出力します。

VBAコードと使い方

1.純粋に元データのある分だけ繰り返し処理
2.そのループの中で注文点数分だけ繰り返し処理
※シート名や、出力したい列を可変出来るようにしていますので、
コード上部にある変数宣言の部分を変えてご使用くださいませ。

Sub 数量分だけ繰り返すマクロ()

Dim row As Integer
row = 2
'メインシートの初期行数と宣言
    
Dim mainsheet As Worksheet
Set mainsheet = Worksheets("Sheet1")
'★元データのあるシートを宣言してセット

Dim resultvalue As Integer
resultvalue = 1
'★元データの何列目を出力するか

Dim resultsheet As Worksheet
Set resultsheet = Worksheets("シリアル")
'★出力先のシートを宣言してセット

Dim tensu As Long
'点数を変数にセット（長整数型）

Dim rcount As Long
'結果シートに記載する行数の確認用

rcount = 2
'結果シートの書き始め行

resultsheet.Columns("A:A").ClearContents
'結果シートをクリア

resultsheet.Cells(1, 1).Value = "シリアル"
'結果シートの1行1列目の項目名

'全体ループ開始：行の値が空になるまで繰り返す
Do Until mainsheet.Cells(row, 1).Value = ""

    tensu = mainsheet.Cells(row, 2).Value
    '注文点数をセット（メインシートにある注文点数）

    '注文点数分同じ処理を繰り返す
    For i = 1 To tensu
        resultsheet.Cells(rcount, 1).Value = mainsheet.Cells(row, resultvalue).Value
        rcount = rcount + 1
    Next
    '結果シートに書き出す小ループ終了

    row = row + 1

Loop
'全体のループ終了

MsgBox "終了しました。"

resultsheet.Select


End Sub

最後に

同じようなデータ作成を求められた方の
お役に立てたら幸いです！