アフィリエイト・アドセンス広告を利用しています。詳細は こちら

Excel VBA - 区切り文字を使ったグループ単位別各行セル内文字列連結処理メモ

Excel VBA でグループ単位に分けられた各行のセル内文字列を、1つのセルにまとめて連結する VBA コードを公開します。

Excel と Excel Visual Basic Editor(VBE)の環境設定については 以前公開した記事 より、VBA コードの基本的な内容については こちらの記事 よりご確認ください。

Excel VBA - 区切り文字を使ったグループ単位別各行セル内文字列連結処理メモ



区切り文字を使ったグループ単位別各行文字列セル内連結用サンプルファイル(xlsx ファイル)

区切り文字を使ったグループ単位別各行文字列セル内連結用のサンプルファイル(xlsx ファイル)を公開します。

サンプルデータは Start Point さんのところで公開しているコピペで使える都道府県一覧リスト・県庁所在地一覧 を加工しています。

こちらで作成した 地方区分グループ化文字列連結A.xlsx ファイル地方区分グループ化文字列連結B.xlsx ファイル を用意しました。ファイル名リンクをクリックすると Google ドライブからダウンロードするようにしています。

地方区分グループ化文字列連結A.xlsx ファイル は VBA コードを実行する前の状態、地方区分グループ化文字列連結B.xlsx ファイル は VBA コード実行後の処理結果内容となっています。

いずれも xlsx ファイルとなっており VBA コードは含まれていません。VBA コードを実行するにはファイル拡張子が xlsm(マクロ有効ブック)となっている必要がありますが、xlsm 形式での配布は念のため避けています。

VBA コードを実行するには 地方区分グループ化文字列連結A.xlsx ファイル をダウンロード後 xlsm 形式に保存、Visual Basic Editor(VBE)を起動して参照設定から「Microsoft Scripting Runtime」を設定(事前バインディング) します。以降各セクションで紹介している VBA コードを各自追加して実行してもらう形としています。

VBA コードの追加方法は VBE のプロジェクトエクスプローラー(Ctrl + R キー)画面にて、開いている VBAProject(ファイル名.xlsm)→「標準モジュール」を開き、右クリックから「挿入」→「標準モジュール」でクリック、追加した標準モジュールに VBA コードを貼り付けることで動作できるようにしています。

一部 VBA コード内にある Call ステートメントを使った Function プロシージャの呼び出し については、呼び出し先標準モジュールのプロパティ(F4 キー)画面から(オブジェクト名)欄を設定するのが前提となっています。

区切り文字を使ったグループ単位別各行セル内文字列連結処理について、If 文と 2次元配列とカウンタ変数を組み合わせて文字列を任意の指定した区切り文字を使って連結する VBA コードを公開します。VBA コードと詳細な内容については 次のセクション から説明します。

区切り文字を使ったグループ単位別各行文字列セル内連結処理 VBA サンプルコード

以下、グループ単位別各行のセル内にある文字列を、区切り文字を使って文字列を連結処理する VBA サンプルコードです。

この VBA コードはシート「地方区分都道府県県庁所在地リスト」の地方区分(A 列)別に分けられた都道府県(B 列)と県庁所在地(C 列)を、地方区分単位で各セルにある都道府県と県庁所在地を区切り文字を使って 1つにセルにまとめて連結します。地方区分単位で都道府県と県庁所在地を 1つのセルに連結後、シート「地方区分グループ化文字列連結」に反映する流れとなっています。

If 文と 2次元配列、カウンタ変数をうまく使い分けることで都道府県と県庁所在地それぞれが同じ地方区分かどうかの判定を行い、地方区分単位で文字列を連結させています。

注意点として都道府県と県庁所在地が同じ地方区分かどうか判定するには、各行で直前の地方区分セルが同じかどうかで判断しています。そのため、シート「地方区分都道府県県庁所在地リスト」の地方区分(A 列)はあらかじめ、同じ地方区分が連続している形で並び替えしている必要があります。

今回公開したサンプルファイル(xlsx ファイル)では地方区分をグループ化できるようにあらかじめ並び替えてあります。もし地方区分の並びがバラバラだった場合はグループ単位に 1つのセルにまとめることができません。

対象の文字列が置換できているかどうか確認できるように、元のセルへ上書きはせず隣の空きセルに転記しています。反映先のセルがわかりやすいように、あらかじめ該当セルを罫線で囲んでいます。

区切り文字を使ったグループ単位別各行文字列セル内連結処理部分以外の基本的な VBA コードについては 以前公開した記事内容 を参照してください。

次のセクション から区切り文字を使ったグループ単位別各行文字列セル内連結処理がある VBA コード部分について内容を説明します。

2023/11/25 追記

以下の VBA コードにはメモリリークを起こす可能性があります。詳細は こちら

こちら でメモリリークを対策した VBA コードを公開します。

Option Explicit

Sub JoinRowsCells1()
  ' シート「地方区分都道府県県庁所在地リスト」の地方区分を基準としてグループ化
  ' 同じグループ内で行別に分かれていたセル内にある都道府県・県庁所在地文字列を区切り文字を使って連結

  ' 実行速度計測開始
  Dim starttime As Double
  starttime = Timer
  
' ----------

  ' カウンタ用変数(一見見分けにくい文字同士を組み合わせない形、i と j、m と n、o(オー) と 0(ゼロ))
  Dim i As Long, k As Long

' ----------

  ' シート格納用オブジェクト変数
  Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("地方区分都道府県県庁所在地リスト") ' 文字列連結対象シートをオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分グループ化文字列連結") ' 文字列連結後データ貼り付け先シートをオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート

' ----------

  ' 最終行取得用変数
  Dim maxrow1 As Long

  ' シート最終行取得して変数に格納
  maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row

  ' 最終列取得用変数
  Dim maxcol1 As Long

  ' シートの最終列取得して変数に格納
  maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

' ----------

  ' シートの指定したセル範囲を配列として格納する動的配列
  Dim data1() As Variant

  ' シートの指定した範囲内セルを配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

' ----------

  Dim myDic As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key1 As String ' Dictionary 用 Key 変数

  ' 地方区分の重複を除いたデータ件数をカウントするための Dictionary 登録処理
  ' 文字列連結対象シートの Key と Item(ダミー)を Dictionary に登録
  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した文字列連結対象シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 文字列連結対象シート i 行目の 1列目(地方区分)を Dictionary 用 Key 変数にセット

    ' Key 重複登録判定
    If Not myDic.Exists(key1) Then
      myDic.Add key1, 1 ' 重複していなければ Key, Item 辞書登録(Key を使ってデータ件数をカウントするため、Item はダミーデータとして 1 に設定)
    End If
  Next i

' ----------

  ' シートの指定したセル範囲を配列として格納する動的配列
  Dim data2() As Variant

  ' シートの指定した範囲内セルを配列として動的配列に格納
  ' Dictionary で登録した Key 登録件数を myDic.Count で呼び出して終点セルの行に指定、始点セルの行は 2 からスタートしているため myDic.Count に + 1 で調整
  data2 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic.Count + 1, 3)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data2 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic.Count + 1, 3)))

' ----------

  ' 文字列連結後データ格納用 2次元配列の最大要素まで Empty で初期化(繰り返し(やり直し)処理に対応)
  For i = LBound(data2, 1) To UBound(data2, 1) ' 1次元最大要素までループ処理
    For k = LBound(data2, 2) To UBound(data2, 2) ' 2次元最大要素までループ処理
      data2(i, k) = Empty
    Next k
'    data2(i, 1) = Empty ' for 文を使わない場合の書き方
'    data2(i, 2) = Empty ' for 文を使わない場合の書き方
'    data2(i, 3) = Empty ' for 文を使わない場合の書き方
  Next i

  ' Redim ステートメントを使った 2次元配列の最大要素までの初期化
'  ReDim data2(1 To UBound(data2, 1), 1 To UBound(data2, 2))

  ' 配列 data2 の 1行目のみ配列 data1 の 1行目のデータを代入(2行目以降の比較・連結用のため初期値として設定)
  For k = LBound(data2, 2) To UBound(data2, 2) ' 2次元最大要素までループ処理
    data2(1, k) = data1(1, k) ' 配列 data1 の 1行目 k 列目のデータを、配列 data2 の 1行目 k 列目に代入
  Next k

' ----------

  Dim p As Long ' 配列 data2 行番号用変数宣言
  p = 1 ' 配列 data2 行番号初期値(1行目からスタート)

  ' 文字列連結判定処理(配列で一つ前のグループ判定用値と比較して一致した場合、各セルにある文字列を区切り文字で連結)
  For i = 2 To UBound(data1, 1) ' 配列 data1 の 2行目から 1次元最大要素までループ処理
    If data1(i - 1, 1) = data1(i, 1) Then ' 配列 data1 の(i - 1)行目(1つ前の行)1列目のデータ(地方区分)と、配列 data1 の i 行目 1列目のデータ(地方区分)が一致した場合
'      data2(p, 1) = data1(i, 1) ' 配列 data1 の i 行目 1列目のデータを、配列 data2 の p 行目 1列目に代入
      data2(p, 2) = data2(p, 2) & vbLf & data1(i, 2) ' 配列 data2 の p 行目 2列目のデータ(都道府県)と配列 data1 の i 行目 2列目のデータ(都道府県)を区切り文字として vbLf(セル内改行)で連結して、配列 data2 の p 行目 2列目に代入
      data2(p, 3) = data2(p, 3) & vbLf & data1(i, 3) ' 配列 data2 の p 行目 3列目のデータ(県庁所在地)と配列 data1 の i 行目 3列目のデータ(県庁所在地)を区切り文字として vbLf(セル内改行)で連結して、配列 data2 の p 行目 3列目に代入
    ElseIf data1(i - 1, 1) <> data1(i, 1) Then ' 配列 data1 の(i - 1)行目(1つ前の行データ)1列目のデータ(地方区分)と、配列 data1 の i 行目 1列目のデータ(地方区分)が一致しなかった場合
      p = p + 1 ' 配列 data2 行番号用変数をインクリメント(+1)
      For k = LBound(data2, 2) To UBound(data2, 2) ' 2次元最大要素までループ処理
        data2(p, k) = data1(i, k) ' 配列 data1 の i 行目 k 列目のデータを、配列 data2 の(インクリメントした)p 行目 k 列目に代入
      Next k
'      data2(p, 1) = data1(i, 1) ' for 文を使わない場合の書き方
'      data2(p, 2) = data1(i, 2) ' for 文を使わない場合の書き方
'      data2(p, 3) = data1(i, 3) ' for 文を使わない場合の書き方
    End If
  Next i

' ----------

  ' 文字列連結データを格納した配列を、Range で指定したセルから Resize で範囲を変更して貼り付け先セルに代入
  ws2.Range("A2").Resize(UBound(data2, 1), UBound(data2, 2)).Value = data2
  ws2.Activate

  ' テスト用シートに出力する場合は以下のテスト用シートを格納したオブジェクト変数に変更
'  ws3.Range("A2").Resize(UBound(data2, 1), UBound(data2, 2)).Value = data2
'  ws3.Activate

' ----------

  ' 実行速度計測結果表示
  Debug.Print Format(Timer - starttime, "0.00秒")
  
End Sub

VBA 以外の方法として Power Query を使うことで、同じグループ同士の文字列を連結することもできます。

以下の参考情報および動画はグループ化後、1列のみを対象に文字列を連結していますが、複数列でも文字列連結が可能です。

基本的なやり方は こちらの動画 の内容の通りで、複数列の場合は 「変換」→「グループ化」の詳細設定を選択した後、「集計の追加」ボタンをクリック して連結させたい文字列がある列の数にあわせて増やします。

「新しい列名」項目に任意の名前を入力(空白は不可)、「操作」項目は動画の内容通りすべて「合計」を選択(処理としては正しくないですが、先に進めるために都合上選択)、「列」項目に連結対象の文字列がある列名を選択して OK ボタンをクリックします。

Error 表示になるのでこれは気にせず、数式バーに列数分の(「グループ化」にある「操作」を「合計」にした場合) List.Sum が複数あるので、これをすべて Text.Combine に書き換えることで、グループ化後の複数列の文字列を連結させることができます。

グループ数カウント処理(重複除外ユニーク数カウント処理)と格納用 2次元配列作成

  ' シート格納用オブジェクト変数
  Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("地方区分都道府県県庁所在地リスト") ' 文字列連結対象シートをオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分グループ化文字列連結") ' 文字列連結後データ貼り付け先シートをオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート

' ----------

  ' 最終行取得用変数
  Dim maxrow1 As Long

  ' シート最終行取得して変数に格納
  maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row

  ' 最終列取得用変数
  Dim maxcol1 As Long

  ' シートの最終列取得して変数に格納
  maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

' ----------

  ' シートの指定したセル範囲を配列として格納する動的配列
  Dim data1() As Variant

  ' シートの指定した範囲内セルを配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

' ----------

  Dim myDic As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key1 As String ' Dictionary 用 Key 変数

  ' 地方区分の重複を除いたデータ件数をカウントするための Dictionary 登録処理
  ' 文字列連結対象シートの Key と Item(ダミー)を Dictionary に登録
  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した文字列連結対象シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 文字列連結対象シート i 行目の 1列目(地方区分)を Dictionary 用 Key 変数にセット

    ' Key 重複登録判定
    If Not myDic.Exists(key1) Then
      myDic.Add key1, 1 ' 重複していなければ Key, Item 辞書登録(Key を使ってデータ件数をカウントするため、Item はダミーデータとして 1 に設定)
    End If
  Next i

' ----------

  ' シートの指定したセル範囲を配列として格納する動的配列
  Dim data2() As Variant

  ' シートの指定した範囲内セルを配列として動的配列に格納
  ' Dictionary で登録した Key 登録件数を myDic.Count で呼び出して終点セルの行に指定、始点セルの行は 2 からスタートしているため myDic.Count に + 1 で調整
  data2 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic.Count + 1, 3)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data2 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic.Count + 1, 3)))

連想配列(Dictionary オブジェクト)を使って グループ単位で連結した各行セル内文字列 を格納する 2次元配列を作成します。

作成する 2次元配列の大きさ(行方向)は連想配列(Dictionary オブジェクト)で重複するグループを除外してユニーク数をカウントすることで求められます。

19~49行で連想配列(Dictionary オブジェクト)に必要なデータ(シート設定、最終列取得、シート内容 2次元配列代入)を用意、53~66行で連想配列(Dictionary オブジェクト)を使って重複するグループを除外してユニーク数をカウント、75行目で Dictionary オブジェクトに対して Count プロパティを使って 2次元配列を作成します。(関連記事

グループ化判定用初期値設定

  ' 文字列連結後データ格納用 2次元配列の最大要素まで Empty で初期化(繰り返し(やり直し)処理に対応)
  For i = LBound(data2, 1) To UBound(data2, 1) ' 1次元最大要素までループ処理
    For k = LBound(data2, 2) To UBound(data2, 2) ' 2次元最大要素までループ処理
      data2(i, k) = Empty
    Next k
'    data2(i, 1) = Empty ' for 文を使わない場合の書き方
'    data2(i, 2) = Empty ' for 文を使わない場合の書き方
'    data2(i, 3) = Empty ' for 文を使わない場合の書き方
  Next i

  ' Redim ステートメントを使った 2次元配列の最大要素までの初期化
'  ReDim data2(1 To UBound(data2, 1), 1 To UBound(data2, 2))

  ' 配列 data2 の 1行目のみ配列 data1 の 1行目のデータを代入(2行目以降の比較・連結用のため初期値として設定)
  For k = LBound(data2, 2) To UBound(data2, 2) ' 2次元最大要素までループ処理
    data2(1, k) = data1(1, k) ' 配列 data1 の 1行目 k 列目のデータを、配列 data2 の 1行目 k 列目に代入
  Next k

83~90行もしくは 93行目で 連想配列(Dictionary オブジェクト)を用いて作成した 2次元配列 を初期化します。(関連記事

96~98行では グループ単位別文字列連結用の初期値として、文字列連結対象の 2次元配列 data1 の 1行目のデータのみ、連想配列(Dictionary オブジェクト)を用いて作成した 2次元配列 data2 の 1行目へ格納します。

これは 2行目以降の比較・連結処理 する際の最初の基準値として利用します。

グループ化判定&文字列連結処理

  Dim p As Long ' 配列 data2 行番号用変数宣言
  p = 1 ' 配列 data2 行番号初期値(1行目からスタート)

  ' 文字列連結判定処理(配列で一つ前のグループ判定用値と比較して一致した場合、各セルにある文字列を区切り文字で連結)
  For i = 2 To UBound(data1, 1) ' 配列 data1 の 2行目から 1次元最大要素までループ処理
    If data1(i - 1, 1) = data1(i, 1) Then ' 配列 data1 の(i - 1)行目(1つ前の行)1列目のデータ(地方区分)と、配列 data1 の i 行目 1列目のデータ(地方区分)が一致した場合
'      data2(p, 1) = data1(i, 1) ' 配列 data1 の i 行目 1列目のデータを、配列 data2 の p 行目 1列目に代入
      data2(p, 2) = data2(p, 2) & vbLf & data1(i, 2) ' 配列 data2 の p 行目 2列目のデータ(都道府県)と配列 data1 の i 行目 2列目のデータ(都道府県)を区切り文字として vbLf(セル内改行)で連結して、配列 data2 の p 行目 2列目に代入
      data2(p, 3) = data2(p, 3) & vbLf & data1(i, 3) ' 配列 data2 の p 行目 3列目のデータ(県庁所在地)と配列 data1 の i 行目 3列目のデータ(県庁所在地)を区切り文字として vbLf(セル内改行)で連結して、配列 data2 の p 行目 3列目に代入
    ElseIf data1(i - 1, 1) <> data1(i, 1) Then ' 配列 data1 の(i - 1)行目(1つ前の行データ)1列目のデータ(地方区分)と、配列 data1 の i 行目 1列目のデータ(地方区分)が一致しなかった場合
      p = p + 1 ' 配列 data2 行番号用変数をインクリメント(+1)
      For k = LBound(data2, 2) To UBound(data2, 2) ' 2次元最大要素までループ処理
        data2(p, k) = data1(i, k) ' 配列 data1 の i 行目 k 列目のデータを、配列 data2 の(インクリメントした)p 行目 k 列目に代入
      Next k
'      data2(p, 1) = data1(i, 1) ' for 文を使わない場合の書き方
'      data2(p, 2) = data1(i, 2) ' for 文を使わない場合の書き方
'      data2(p, 3) = data1(i, 3) ' for 文を使わない場合の書き方
    End If
  Next i

グループ(地方区分)別に分けられた文字列(都道府県と県庁所在地)を、グループ化して区切り文字を使って連結します。この記事では区切り文字にセル内改行の vbLf を使います。

ここの文字列を連結するかどうかを判定する処理では、参照中のセルと一つ前の行にあるグループ名(地方区分)を使って比較するため、連結した文字列格納用 2次元配列の 1行目にあらかじめ初期値としてグループ名と連結対象文字列を格納 しておく必要があります。

102~103行で連結した文字列格納用 2次元配列 data2 の行番号用変数の宣言と、1行目からスタートするため初期値として 1 をセットします。

106行目の For 文と LBound・UBound 関数で、連結対象の文字列が格納されている 2次元配列 data1 の 1次元最大要素(行相当)までループ処理します。この時カウンタ変数の開始値は 2 からスタートするようにして 2次元配列の 2行目から始めるように調整しています。この理由については 107・111行目の If 文の処理で説明します。

107行目の If 文で、2次元配列 data1 の (i - 1) 行目(1つ前の行)1列目のグループ名(地方区分名)と、同じ 2次元配列配列 data1 の i 行目 1列目のグループ名(地方区分名)が一致するかどうか判定します。106行目のカウンタ変数の開始値を 2 からスタートさせたのは、比較対象の 2次元配列のひとつ前の行を (i - 1) で指定できるようにするためです。これによりカウンタ変数の値に対して常にひとつ前の行を指定して比較するようにできます。

107行目の If 文でグループ名(地方区分名)が一致した場合、109~110行で区切り文字(ここでは vbLf 使用)を使って、連結した文字列が格納されている 2次元配列 data2 と、連結対象文字列が格納されている 2次元配列 data1 の各要素をアンパサンド(&)で結合します。

その結果を左辺に同じ 2次元配列 data2 の同じ要素番号に格納して繰り返す更新することで、同じグループ名がある間は対象の文字列を連結し続けることができます。

この時 2次元配列 data2 の 1次元には 102~103行で設定した変数 p(data2(p, 2)data2(p, 3))を、2次元配列 data1 の 1次元には 106行目 For 文のカウンタ変数 i(data1(i, 2)data1(i, 3))を指定しています。

これは連結した文字列の格納先 2次元配列 data2 は、同じグループ名が続いている間は固定行に格納し続けなければならないため、判定でグループ名が変わるまでは同じ変数 p の値のままにしておく必要があります。対して 2次元配列 data1 には連結対象の文字列が各行に格納されているため、カウンタ変数 i で要素番号をインクリメントさせて 2次元配列の各要素を指定させることができます。

ちなみに 108行目はグループ名である地方区分名を 2次元配列に格納していますが、コメントアウトしても問題なく処理できます。これはグループ名の文字列連結処理が不要なため繰り返し処理する必要がないのと、114行目でグループ名が変わったときにグループ名を含めた文字列 1行分を 2次元配列に格納してるので、グループ名の代入が不要ということになっているからです。

111行目の ElseIf 文は 107行目の If 文の条件式で一致しなかった場合(等号 = から不等号 <> に変更)の判定式です。つまりグループ名(地方区分)が変わったかどうかの判定で、変更があればその処理を 112~115行で行います。

112行目で変数 p をインクリメントします。グループ名が変更となったこのタイミングで 2次元配列 data2 の 1次元で指定した変数 p の行番号を次に移動させています。

113行目の For 文と LBound・UBound 関数およびカウンタ変数 k を使って、2次元配列 data2 の 2次元最大要素(列相当)までループ処理します。

2次元配列 data1 の i 行目 k 列目のデータを、2次元配列 data2 の(112行目で インクリメントした)p 行目 k 列目に代入することで、次の比較対象のグループ名と連結対象文字列を 2次元配列 data2 にセットし、以降 106行目の For 文が終わるまで処理を繰り返します。

Excel VBA コードメモリリーク対策について

X(Twitter) にて教えてもらいましたが、LBound と UBound 関数を使用した VBA コードの書き方によってはメモリリークが起きる可能性があるようです。

ただ、指摘のあった関数による VBA コードのメモリリークについて日本語で言及している情報が少なく、今回公開した VBA コードが原因でメモリリークが起きるかどうか確認できていません。(こちらで単純にメモリリークに気づいていないというのもあります)

X(Twitter) で紹介してもらった こちらのサイト ではメモリリークする・しないコードの書き方が紹介されています。以下各セクションではこの書き方にならって、コード内容を書き直したメモリリーク対策版 VBA コードを公開します。

メモリリークが起きないとされているコード内容に修正しただけなので、実際にメモリリークが起きないかどうかまでは確認していません。

基本的に関数の返り値を一度変数に格納して、その変数を使用する方法に書き換えた内容となっています。各コードについて元の VBA コードから追加・変更した箇所をハイライトで表示しています。

区切り文字を使ったグループ単位別各行文字列セル内連結処理 VBA サンプルコード メモリリーク対策版

Option Explicit

Sub JoinRowsCells1FixMemoryLeaks1() ' メモリリーク対策版
  ' シート「地方区分都道府県県庁所在地リスト」の地方区分を基準としてグループ化
  ' 同じグループ内で行別に分かれていたセル内にある都道府県・県庁所在地文字列を区切り文字を使って連結

  ' 実行速度計測開始
  Dim starttime As Double
  starttime = Timer
  
' ----------

  ' カウンタ用変数(一見見分けにくい文字同士を組み合わせない形、i と j、m と n、o(オー) と 0(ゼロ))
  Dim i As Long, k As Long

' ----------

  ' シート格納用オブジェクト変数
  Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("地方区分都道府県県庁所在地リスト") ' 文字列連結対象シートをオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分グループ化文字列連結") ' 文字列連結後データ貼り付け先シートをオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート

' ----------

  ' 最終行取得用変数
  Dim maxrow1 As Long

  ' シート最終行取得して変数に格納
  maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).row

  ' 最終列取得用変数
  Dim maxcol1 As Long

  ' シートの最終列取得して変数に格納
  maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

' ----------

  ' シートの指定したセル範囲を配列として格納する動的配列
  Dim data1() As Variant

  ' シートの指定した範囲内セルを配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

' ----------

  Dim myDic As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key1 As String ' Dictionary 用 Key 変数

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data1_1D As Variant, UB_data1_1D As Variant
  LB_data1_1D = LBound(data1, 1)
  UB_data1_1D = UBound(data1, 1)

  ' 地方区分の重複を除いたデータ件数をカウントするための Dictionary 登録処理
  ' 文字列連結対象シートの Key と Item(ダミー)を Dictionary に登録
  For i = LB_data1_1D To UB_data1_1D ' 配列に格納した文字列連結対象シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 文字列連結対象シート i 行目の 1列目(地方区分)を Dictionary 用 Key 変数にセット

    ' Key 重複登録判定
    If Not myDic.Exists(key1) Then
      myDic.Add key1, 1 ' 重複していなければ Key, Item 辞書登録(Key を使ってデータ件数をカウントするため、Item はダミーデータとして 1 に設定)
    End If
  Next i

' ----------

  ' シートの指定したセル範囲を配列として格納する動的配列
  Dim data2() As Variant

  ' シートの指定した範囲内セルを配列として動的配列に格納
  ' Dictionary で登録した Key 登録件数を myDic.Count で呼び出して終点セルの行に指定、始点セルの行は 2 からスタートしているため myDic.Count に + 1 で調整
  data2 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic.Count + 1, 3)).Value

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data2 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(myDic.Count + 1, 3)))

' ----------

  ' 文字列連結後データ格納用 2次元配列の最大要素まで Empty で初期化(繰り返し(やり直し)処理に対応)

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data2_1D As Variant, UB_data2_1D As Variant
  Dim LB_data2_2D As Variant, UB_data2_2D As Variant
  LB_data2_1D = LBound(data2, 1)
  UB_data2_1D = UBound(data2, 1)
  LB_data2_2D = LBound(data2, 2)
  UB_data2_2D = UBound(data2, 2)

  For i = LB_data2_1D To UB_data2_1D ' 1次元最大要素までループ処理
    For k = LB_data2_2D To UB_data2_2D ' 2次元最大要素までループ処理
      data2(i, k) = Empty
    Next k
'    data2(i, 1) = Empty ' for 文を使わない場合の書き方
'    data2(i, 2) = Empty ' for 文を使わない場合の書き方
'    data2(i, 3) = Empty ' for 文を使わない場合の書き方
  Next i

  ' Redim ステートメントを使った 2次元配列の最大要素までの初期化
'  ReDim data2(1 To UB_data2_1D, 1 To UB_data2_2D)

  ' 配列 data2 の 1行目のみ配列 data1 の 1行目のデータを代入(2行目以降の比較・連結用のため初期値として設定)
  For k = LB_data2_2D To UB_data2_2D ' 2次元最大要素までループ処理
    data2(1, k) = data1(1, k) ' 配列 data1 の 1行目 k 列目のデータを、配列 data2 の 1行目 k 列目に代入
  Next k

' ----------

  Dim p As Long ' 配列 data2 行番号用変数宣言
  p = 1 ' 配列 data2 行番号初期値(1行目からスタート)

  ' 文字列連結判定処理(配列で一つ前のグループ判定用値と比較して一致した場合、各セルにある文字列を区切り文字で連結)
  For i = 2 To UB_data1_1D ' 配列 data1 の 2行目から 1次元最大要素までループ処理
    If data1(i - 1, 1) = data1(i, 1) Then ' 配列 data1 の(i - 1)行目(1つ前の行)1列目のデータ(地方区分)と、配列 data1 の i 行目 1列目のデータ(地方区分)が一致した場合
'      data2(p, 1) = data1(i, 1) ' 配列 data1 の i 行目 1列目のデータを、配列 data2 の p 行目 1列目に代入
      data2(p, 2) = data2(p, 2) & vbLf & data1(i, 2) ' 配列 data2 の p 行目 2列目のデータ(都道府県)と配列 data1 の i 行目 2列目のデータ(都道府県)を区切り文字として vbLf(セル内改行)で連結して、配列 data2 の p 行目 2列目に代入
      data2(p, 3) = data2(p, 3) & vbLf & data1(i, 3) ' 配列 data2 の p 行目 3列目のデータ(県庁所在地)と配列 data1 の i 行目 3列目のデータ(県庁所在地)を区切り文字として vbLf(セル内改行)で連結して、配列 data2 の p 行目 3列目に代入
    ElseIf data1(i - 1, 1) <> data1(i, 1) Then ' 配列 data1 の(i - 1)行目(1つ前の行データ)1列目のデータ(地方区分)と、配列 data1 の i 行目 1列目のデータ(地方区分)が一致しなかった場合
      p = p + 1 ' 配列 data2 行番号用変数をインクリメント(+1)
      For k = LB_data2_2D To UB_data2_2D ' 2次元最大要素までループ処理
        data2(p, k) = data1(i, k) ' 配列 data1 の i 行目 k 列目のデータを、配列 data2 の(インクリメントした)p 行目 k 列目に代入
      Next k
'      data2(p, 1) = data1(i, 1) ' for 文を使わない場合の書き方
'      data2(p, 2) = data1(i, 2) ' for 文を使わない場合の書き方
'      data2(p, 3) = data1(i, 3) ' for 文を使わない場合の書き方
    End If
  Next i

' ----------

  ' 文字列連結データを格納した配列を、Range で指定したセルから Resize で範囲を変更して貼り付け先セルに代入
  ws2.Range("A2").Resize(UB_data2_1D, UB_data2_2D).Value = data2
  ws2.Activate

  ' テスト用シートに出力する場合は以下のテスト用シートを格納したオブジェクト変数に変更
'  ws3.Range("A2").Resize(UB_data2_1D, UB_data2_2D).Value = data2
'  ws3.Activate

' ----------

  ' 実行速度計測結果表示
  Debug.Print Format(Timer - starttime, "0.00秒")
  
End Sub