【VBA】特定の文字を起点に列を変えてデータを並べる

具体的には冒頭の画像のように
元は1列に並んでいたデータを
「あるキーワード(文字)」を起点に

1列に並んだデータ → 2列に並び替え・整理
2列に並んだデータ → 1列に並び替え・整理

列を変えてデータを並び替えする・整理するサンプルコードを
記載しようと思います。
 

広告

『1列のデータ』→『2列』に整理する

VBA_特定の文字を起点に列を変えてデータを並べる_1
1列に並んだデータを [左画] 、2列に整理する[右図]

例題としては、冒頭の画像のように、A列に1列に並んだデータを、「カテゴリー」という言葉を起点に、2列に並び替えて整理させるVBAコードサンプルを下記に載せます。

Dim myKeyWord As String
Dim i, EndLine, cnt As Long
  EndLine = Cells(Rows.Count, 1).End(xlUp).Row
  cnt = 1   
For i = 1 To EndLine
  myKeyWord = Cells(i, 1)
  If myKeyWord Like "カテゴリー*" Then    'もしも「カテゴリー」という言葉から始まるならば
    Cells(cnt, 3) = myKeyWord
  Else
    Cells(cnt, 4) = myKeyWord
    cnt = cnt + 1
  End If
Next i

「カテゴリー※」という部分を起点に
列を分けてデータを、セル【D1】を出発点に整理できました。

ポイントとしては、ワイルドカードとLike演算子で「カテゴリー」で始まるかをIf文で識別し処理するところです。
「カテゴリー*」という記述であれば、以下の記述を選別・識別します。

例:
◆「カテゴリー」
◆「カテゴリー
◆「カテゴリーA
◆「カテゴリーあいう」 …等

後述しますが、
整理後の並びは、何となくピボットテーブルの表示に似ていますね。
 

『2列のデータ』→『1列』に整理する

VBA_特定の文字を起点に列を変えてデータを並べる_2
2列に並んだデータを [左画] 、1列に整理する[右図]

例題としては、冒頭の画像の逆を実行します。
A-B列に並んだデータを、「カテゴリー」という言葉を起点に、1列に並び替えて整理させるVBAコードサンプルを下記に載せます。
※「カテゴリー」の下の空白セルは空白であり、結合はしていません。

Dim myKeyWord As String
Dim i, EndLine, cnt As Long
  EndLine = Cells(Rows.Count, 2).End(xlUp).Row
  cnt = 1
   
For i = 1 To EndLine
  myKeyWord = Cells(i, 1)
  If myKeyWord Like "カテゴリー*" Then    'もしも「カテゴリー」という言葉から始まるならば
    Cells(cnt, 4) = myKeyWord
    cnt = cnt + 1
    Cells(cnt, 4) = Cells(i, 2)               '①
    cnt = cnt + 1                          '②
  ElseIf myKeyWord = "" Then
    Cells(cnt, 4) = Cells(i, 2)
    cnt = cnt + 1
  End If
Next i

ポイントは「カテゴリー※」を発見した場合は
少し処理を多くしている点です。追加処理は①②の部分です。
この他は、はじめの例題と大差はありません。
 

『ピボットデータ』→『1列』に整理する

VBA_特定の文字を起点に列を変えてデータを並べる_3
ピボットテーブルのデータを [左画] 、1列に整理する[右図]

2列にまとまったデータが何となく、ピボットテーブルの表データに似ていたので、コードを作成してみました。いったいどれくらいの人の参考になるか分かりませんが。(笑)サンプルコードは以下になります。

Dim myKeyWord As String
Dim i, EndLine, cnt As Long

  EndLine = Cells(Rows.Count, 1).End(xlUp).Row
  cnt = 1
   
For i = 1 To EndLine
  myKeyWord = Cells(i, 1)
  If myKeyWord Like "カテゴリー*" And Not myKeyWord Like "*集計" And myKeyWord <> "カテゴリー" Then
    Cells(cnt, 5) = myKeyWord
    cnt = cnt + 1
    Cells(cnt, 5) = Cells(i, 2)
    cnt = cnt + 1
  ElseIf myKeyWord = "" Then
    Cells(cnt, 5) = Cells(i, 2)
    cnt = cnt + 1
  End If
Next i

今回、【C列】に有る数値までは整理しませんでしたが、
必要とあらば、[ElseIf myKeyWord = “” Then]の1行前に

Cells(cnt, 5) = Cells(i, 3)
cnt = cnt + 1

と追記すれば、数値も追記出来ます。

以上になります、何かの参考になれば幸いです。

広告