Excel VBA 区切った文字数分の行挿入して一覧を作成する

ExcelVBA-実用編

2020.02.27

VBAで区切った文字数分の行を挿入して、一覧を作成する方法をご紹介したいと思います。

どのようなケースに対する処理かと言いますと、1つの項目に対し「レッド・ブルー・グリーン」など1つのセルに複数の文字列が、繋がって入力されているセルを分解して、区切られた文字数分の行を追加して一覧を作成したい時に使用します。

データの前処理をする際に実際に直面した内容でしたので、実務的な内容になっています。

具体的な例をもとに説明していきます。

最適化されたロジックではないかもしれませんので、あくまでも手法の1つとして参考にしてください。

行の基本的な操作については「行の選択、取得、追加(挿入)、削除」をご覧ください。

1.使用するデータと処理後のデータ
2.処理をするコード

1.使用するデータと処理後のデータ

まずは使用する処理前のデータと、今回の処理を行った後のデータについてです。

見て頂ければ大体の内容がわかるかと思います。

処理前のデータ

下の図のように、カラー項目が1つのセルに大量に色が「・」で区切られて入力されています。

もしこれが何かしらのマスタとなっていた場合は、とてもじゃないですが汎用性がありません。

処理後のデータ

今回の処理を行ってカラーをすべて区切り、区切った文字数分の行を挿入して一覧にしています。

10行程度ですと手動でも対応できるかもしれませんが、これが数百行になるだけでも手動では厳しい作業になります。

2.処理をするコード

それでは実際に処理をするVBAについてご紹介したいと思います。

実際のコードはそんなに複雑でもなく、長くもないです。

サンプルコード

上記の図の処理を行った実際のコードです。

Sub Sample1()

Dim i       As Long
Dim n       As Long
Dim MaxRow  As Long
Dim MyStr   As String
Dim temp    As Variant
Dim AddRow  As Long

'最終行を取得する
MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

'行を挿入する場合は下から
For i = MaxRow To 2 Step -1
    
    '分解したいセルを指定する
    MyStr = Cells(i, 2)
    
    ',で区切って変数に格納する
    temp = Split(MyStr, "・")
    
    '区切った要素数を取得する
    AddRow = UBound(temp)
    
    '行挿入の際に要素数0だとエラーになるので判定する
    If AddRow > 0 Then
        
        '要素数分行挿入する
        Range("A" & i + 1).Resize(AddRow).EntireRow.Insert
        
    End If
     
    '要素数分ループして基準となる項目を反映して、区切った文字列を入力する
    For n = 0 To AddRow
    
        Cells(i + n, 1) = Cells(i, 1)
        Cells(i + n, 2) = temp(n)
    
    Next n

Next i

End Sub