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



Excel VBA - 配列を使ったセル検索(完全一致)置換処理メモ

Excel VBA で配列を使ってセル内容を検索・置換する VBA コードを公開します。

この記事で紹介するセル置換は指定した検索文字列に完全一致したものが対象となります。セル内で部分一致した文字列は置換しません。副産物として逐次セル置換する方法とは別に、偶然思いついた配列に格納した置換対象の行番号を取得して、まとめて置換する 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 形式に保存、一部の VBA コードでは Visual Basic Editor(VBE)を起動して参照設定から「Microsoft Scripting Runtime」を設定(事前バインディング) が必要です。以降各セクションで紹介している VBA コードを各自追加して実行してもらう形としています。

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

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

セル検索(完全一致)置換処理について、配列を使って指定した文字列があるセル内容を完全一致で検索して置換する VBA コードを 6種類公開します。セル検索・置換については完全に一致した文字列が処理対象 です。部分一致ではない 点に注意してください。部分一致については こちらの記事 を参照ください。

VBA コードと詳細な内容については各セクションで説明します。いずれも処理結果は同じになりますが、大量のデータを用いてのテストはしていないため、データ件数によっては処理速度に大きな違いが出る可能性があります。

今回公開する 6種類の VBA コードのうち、最後に紹介する 連想配列(Dictionary オブジェクト)と 2次元配列を使った完全一致検索・置換処理コード が大量のデータ件数を扱う場合では最速で置換できるかと思います。

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 1

以下、配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 1 です。

この VBA コードはシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換1」の F 列(地方区分)の各セルにある地方区分名を 2次元配列に格納、あらかじめ用意した検索文字列で 2次元配列に格納した文字列の検索(完全一致)を行います。

検索処理で完全一致した 2次元配列の文字列を置換したい文字列に変換(日本語名から英語名に置換)、その結果を G 列(地方区分置換)に反映します。検索で一致なしの場合は置換せず元の文字列のままです。

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

セル検索(完全一致)置換処理部分以外の基本的な VBA コードについては 以前公開した記事内容 を参照してください。

次のセクション では配列を使ったセル検索(完全一致)置換処理がある VBA コード部分について内容を説明します。

2023/10/28 追記

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

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

Option Explicit

Sub MatchCellReplaceCell1()
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' If 文による条件式のみ

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換1") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換1」をオブジェクト変数にセット
'  Set ws2 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' If 文でキーワード検索・完全一致した場合、別の文字列に書き換え

  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "関東地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「関東地方」が完全一致した場合
      data1(i, 1) = "Kanto Region" ' 配列 data1 の i 行 1列目に文字列 Kanto Region を代入
    End If
  Next i

  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "四国地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「四国地方」が完全一致した場合
      data1(i, 1) = "Shikoku Region" ' 配列 data1 の i 行 1列目に文字列 Shikoku Region を代入
    End If
  Next i

  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "関西地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「関西地方」が完全一致した場合
      data1(i, 1) = "Kasai Region" ' 配列 data1 の i 行 1列目に文字列 Kasai Region を代入
    End If
  Next i

' ----------

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UBound(data1, 1), UBound(data1, 2)).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

For ~ If 文を使って 2次元配列検索(完全一致)置換処理

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' If 文でキーワード検索・完全一致した場合、別の文字列に書き換え

  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "関東地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「関東地方」が完全一致した場合
      data1(i, 1) = "Kanto Region" ' 配列 data1 の i 行 1列目に文字列 Kanto Region を代入
    End If
  Next i

  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "四国地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「四国地方」が完全一致した場合
      data1(i, 1) = "Shikoku Region" ' 配列 data1 の i 行 1列目に文字列 Shikoku Region を代入
    End If
  Next i

  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "関西地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「関西地方」が完全一致した場合
      data1(i, 1) = "Kasai Region" ' 配列 data1 の i 行 1列目に文字列 Kasai Region を代入
    End If
  Next i

For ~ If 文を使って 2次元配列に格納した文字列を検索(完全一致)して置換処理をします。

39行目では配列による検索・置換処理のため、検索対象の文字列があるシートの指定したセル範囲を 2次元配列に格納します。

48行目で For 文とカウンタ変数、LBound・UBound 関数を使って、検索対象の文字列を格納した 2次元配列 data1 の 1次元最大要素(行相当)までループ処理します。

49行目の If 文で検索対象の文字列を格納している 2次元配列の i 行 1 列目に対して、検索文字列を入力して検索します。この検索方法は完全一致した場合にヒットする検索方法のため、部分一致ではヒットしません。

49行目で検索文字列がヒットした場合、50行目で検索でヒットした文字列がある 2次元配列 i 行 1 列目に、置換したい文字列を入力して代入します。

以降、48~52 行目の For ~ If 文を繰り返して検索文字列と置換文字列を書き換え、検索で完全一致した 2次元配列に格納した文字列を置換していきます。

以上が 2次元配列に対して直接検索・置換文字列を直接指定した完全一致の検索・置換方法です。シンプルでわかりやすいコード内容ですが、検索・置換対象が増えるにつれてその分コードが長くなってしまい、検索・置換文字列分のコードをコピペして書き換えるといったことをしないといけないところが難点です。

次のセクション では検索・置換文字列もあらかじめ配列に設定しておくことで、検索・置換処理のコード部分をシンプルにすることができます。

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2

以下、配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2 です。

VBA サンプルコード 1 では検索・置換対象が多いとコードが長くなってしまい、検索・置換文字列もその都度入力設定しないといけないところが難点でした。

この VBA サンプルコード 2 では検索・置換文字列も配列に設定しておくことで、検索・置換処理部分のコードをシンプルにすることができます。

次のセクション から VBA サンプルコード 1 から変更点があるコード部分について内容を説明します。

2023/10/28 追記

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

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

Option Explicit

Sub MatchCellReplaceCell2()
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 配列に格納した検索キーワードと書き換え文字列を If 文の条件式で判定

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換2") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換2」をオブジェクト変数にセット
'  Set ws2 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言

  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

' ----------

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
      If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
        data1(i, 1) = regionname2(p) ' 配列 data1 の i 行 1列目に、配列 regionname2 の要素番号 p に格納してある文字列を代入
      End If
    Next i
  Next p
  
' ----------

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UBound(data1, 1), UBound(data1, 2)).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

配列に検索・置換文字列設定

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言

  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

47行目に検索・置換文字列を配列に格納するために、変数をバリアント型(Variant)の動的配列として宣言します。

49行目で Array 関数を使って検索文字列を動的配列に代入します。同様に 50行目では動的配列に Array 関数を使って置換文字列を代入します。この時 Array 関数の各要素の検索・置換文字列は必ず対になるようにします。

に検索・置換文字列を格納した 1次元配列を使って For ~ If 文で置換します。

For ~ If 文と 1次元配列に格納した検索・置換文字列を使って 2次元配列検索(完全一致)置換処理

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
      If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
        data1(i, 1) = regionname2(p) ' 配列 data1 の i 行 1列目に、配列 regionname2 の要素番号 p に格納してある文字列を代入
      End If
    Next i
  Next p

1次元配列に格納した検索・置換文字列 を使って置換処理をします。

54行目の For 文とカウンタ変数、LBound 関数と UBound 関数を組み合わせて、1次元配列 regionname1 の最小~最大要素までループさせます。ここでは 1次元配列の要素数分だけループ処理ができればいいので、置換文字列を格納した 1次元配列 regionname2 に変更しても同じです。ここでは検索文字列を格納した 1次元配列 regionname1 を使っています。

55行目で For ~ If 文を使って 2次元配列に格納した文字列を検索(完全一致)して置換処理をします。ここは 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 1 と同じです。

56~57行目も 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 1 にある If 文による検索・置換処理と同じですが一部変更しています。

変更箇所は 56行目では検索文字列を直接指定していた代わりに検索文字列を格納した 1次元配列 regionname1 に、57行目では置換文字列を直接指定していた代わりに置換文字列を格納した 1次元配列 regionname2 に、それぞれカウンタ変数 p を使って要素番号を指定して、ループ処理で検索・置換するようにしています。

以上が 2次元配列に対して 1次元配列に格納した検索・置換文字列を使った完全一致の検索・置換方法です。

検索・置換処理コードがまとめられてすっきりしていますが、検索・置換文字列を配列の要素番号の対になるように格納しなければならないため、検索・置換対象を追加・変更・削除しようとすると使い勝手はあまりよくありません。

次に紹介する 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 3 では検索・置換文字列をあらかじめシートにまとめておくことで、コード内に直接検索・置換文字列を書く必要がないようにしています。

配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 1

以下、配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 1 です。

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2 を流用したもので、検索で完全一致した文字列がある行番号を配列に格納して、その行番号を使って置換処理するというものです。

コードが結構長くなるので実際に使い道があるかどうかわかりませんが、こういった方法でも検索・置換処理ができるということで一応紹介します。

2023// 追記

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

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

Option Explicit

Sub MatchCellReplaceCell3()
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 検索キーワードと書き換え文字列を配列に格納、検索キーワードと完全一致した配列の行番号情報を使って文字列を書き換え

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換3") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換3」をオブジェクト変数にセット
'  Set ws2 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
'  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言
  Dim rowsdata1() As Variant ' 地方区分列で検索キーワードがある行番号を配列として格納する動的配列

  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

' ----------

  ' 変数宣言
  Dim countrow1 As Long ' 地方区分列で完全一致した検索キーワードの個数を格納する変数

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    ' 地方区分列にある検索キーワードと完全一致した個数をカウントする処理
    countrow1 = 0 ' 検索キーワード個数カウント用変数 countrow1 の初期化

    ' WorksheetFunction.CountIf メソッドを使って地方区分列にある、検索キーワードと完全一致した個数をカウント
    countrow1 = WorksheetFunction.CountIf(ws1.Range("F:F"), regionname1(p))

    ' WorksheetFunction.CountIf メソッドを使わない場合の For ~ If 文による個数カウント処理
'    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
'      If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
'        countrow1 = countrow1 + 1 ' 検索キーワード完全一致個数カウント用変数 countrow1 をインクリメント(+1)
'      End If
'    Next i

    If countrow1 > 0 Then ' カウントとした検索キーワード個数が 1個以上あれば処理(変数 countrow1(検索キーワード個数)が 0 の場合、次の ReDim ステートメントで countrow1 を指定するとエラーとなるため If 文の条件式で判定)
      ' 地方区分列の検索キーワードがある行番号を、配列 rowsdata1 に格納する処理
      ReDim rowsdata1(1 To countrow1, 1 To 1) ' 変数 rowsdata1 に地方区分列でカウントした検索キーワードの個数を行数とする 2次元配列作成

      k = 0 ' 配列 rowsdata1 用行番号変数の宣言と初期化

      For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
        If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
          k = k + 1 ' 配列 rowsdata1 の行番号 k をインクリメント(+1)
          ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した時のループ処理変数 i(検索キーワードが完全一致した配列の行番号相当)を、配列 rowsdata1 の 行番号 k に代入
          rowsdata1(k, 1) = i
        End If
      Next i

      For i = LBound(rowsdata1, 1) To UBound(rowsdata1, 1) ' 配列 rowsdata1 の 1次元最大要素までループ処理
        data1(rowsdata1(i, 1), 1) = regionname2(p) ' 配列 data1 の rowsdata1(i, 1) 行 1列目に、配列 regionname2 の要素番号 p に格納してある文字列を代入
      Next i
    End If

  Next p
  
' ----------

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UBound(data1, 1), UBound(data1, 2)).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

1次元配列に格納した検索文字列から行番号取得・置換処理

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言
  Dim rowsdata1() As Variant ' 地方区分列で検索キーワードがある行番号を配列として格納する動的配列

  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

' ----------

  ' 変数宣言
  Dim countrow1 As Long ' 地方区分列で完全一致した検索キーワードの個数を格納する変数

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    ' 地方区分列にある検索キーワードと完全一致した個数をカウントする処理
    countrow1 = 0 ' 検索キーワード個数カウント用変数 countrow1 の初期化

    ' WorksheetFunction.CountIf メソッドを使って地方区分列にある、検索キーワードと完全一致した個数をカウント
    countrow1 = WorksheetFunction.CountIf(ws1.Range("F:F"), regionname1(p))

    ' WorksheetFunction.CountIf メソッドを使わない場合の For ~ If 文による個数カウント処理
'    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
'      If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
'        countrow1 = countrow1 + 1 ' 検索キーワード完全一致個数カウント用変数 countrow1 をインクリメント(+1)
'      End If
'    Next i

    If countrow1 > 0 Then ' カウントとした検索キーワード個数が 1個以上あれば処理(変数 countrow1(検索キーワード個数)が 0 の場合、次の ReDim ステートメントで countrow1 を指定するとエラーとなるため If 文の条件式で判定)
      ' 地方区分列の検索キーワードがある行番号を、配列 rowsdata1 に格納する処理
      ReDim rowsdata1(1 To countrow1, 1 To 1) ' 変数 rowsdata1 に地方区分列でカウントした検索キーワードの個数を行数とする 2次元配列作成

      k = 0 ' 配列 rowsdata1 用行番号変数の宣言と初期化

      For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
        If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
          k = k + 1 ' 配列 rowsdata1 の行番号 k をインクリメント(+1)
          ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した時のループ処理変数 i(検索キーワードが完全一致した配列の行番号相当)を、配列 rowsdata1 の 行番号 k に代入
          rowsdata1(k, 1) = i
        End If
      Next i

      For i = LBound(rowsdata1, 1) To UBound(rowsdata1, 1) ' 配列 rowsdata1 の 1次元最大要素までループ処理
        data1(rowsdata1(i, 1), 1) = regionname2(p) ' 配列 data1 の rowsdata1(i, 1) 行 1列目に、配列 regionname2 の要素番号 p に格納してある文字列を代入
      Next i
    End If

  Next p

1次元配列に格納した検索・置換文字列 を使って 2次元配列に検索文字列がある行番号を格納して置換処理をします。

48行目に検索文字列がある行番号を一時的に配列へ格納するために、変数をバリアント型(Variant)の動的配列として追加で宣言しています。これは 74行目の Redim ステートメントで 2次元配列にします。

56行目で完全一致で見つかった検索キーワードの個数を一時的に格納する変数を宣言します。各検索文字列に対して完全一致した個数を格納するため、60行目の For 文内で毎回 0 に初期化しています。

58行目の For 文とカウンタ変数、LBound 関数と UBound 関数を組み合わせて、1次元配列 regionname1 の最小~最大要素までループさせます。これは 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2 にある For ~ If 文と 1次元配列に格納した検索・置換文字列を使って 2次元配列検索(完全一致)置換処理 の、54行目にある For 文と同じコードです。

63行目でワークシート関数(WorksheetFunction)の CountIf を使って、1次元配列の要素番号 p(58行目のカウンタ変数)に格納した検索文字列の個数をカウントして、その結果を 56行目で宣言した変数に格納します。

ちなみにコメントアウトした 66~69行目のコードはワークシート関数(WorksheetFunction)の CountIf を使わない場合の個数カウント方法です。

72行目の If 文で完全一致で見つかった検索文字列の個数が格納された変数(56行目で宣言)が、0 より大きいか判定しています。カウント個数が 1 以上であれば If 文内にある置換処理を行います。0 の場合は検索した文字列がなく置換する必要がないので、If 文内の置換処理はしないということになります。

74行目で Redim ステートメントを使って 48行目に宣言した動的配列を 2次元配列にします。1次元・2次元ともに開始要素番号は 1 から、1次元の最大要素数には完全一致で見つかった検索文字列の個数が格納された変数(56行目で宣言)を指定、2次元は 1 To 1 で固定です。

76行目でカウント変数 k を 0 に初期化します。これは 74行目の 2次元配列の 1次元の要素番号を順番に指定するのに使用します。

78~84行目で For ~ If 文を使って、2次元配列に格納した文字列を検索(完全一致)して見つかった行番号を、74行目の 2次元配列の 1次元に格納します。

78行目は For 文とカウンタ変数、LBound・UBound 関数を使って、検索対象の文字列を格納した 2次元配列 data1 の 1次元最大要素(行相当)までループ処理、79行目の If 文で検索対象の文字列を格納している 2次元配列の i 行 1 列目に対して、検索文字列を格納した 1次元配列 regionname1 をカウンタ変数 p を使って要素番号を指定して、ループ処理で検索します。これは 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2 にある For ~ If 文と 1次元配列に格納した検索・置換文字列を使って 2次元配列検索(完全一致)置換処理 の、55~56行目にある For ~ If 文と同じコードです。

79行目で検索文字列がヒットした場合、80行目でカウンタ変数 k をインクリメント(+1)、74行目の 2次元配列の 1次元にカウンタ変数 k を、2次元は 1 を指定して 78行目のカウンタ変数 i を代入します。このカウンタ変数 i は検索対象文字列が格納された 2次元配列 data1 から検索でヒットした行番号を指していることになります。

86~88行目で検索文字列がヒットした行番号を格納した 2次元配列を使って置換処理をします。

86行目の For 文で行番号を格納した 2次元配列の最大要素数までループ処理をします。

87行目で右辺に置換文字列を格納した 1次元配列 regionname2 のカウンタ変数 p を使った要素番号に格納されている置換文字列を指定します。左辺の検索対象の文字列を格納した 2次元配列 data1 の 1次元に、行番号を格納した 2次元配列 rowsdata1 の i 行 1列目、2次元に 1 を指定したところに先ほどの右辺を代入します。これで 2次元配列に格納されている文字列を置換することができます。

もともとは For ~ If 文で配列同士で毎回逐次検索・置換という処理を行うのは効率が良くないのではと思い、そこで検索でヒットした行番号を格納して、その行番号を使って対象の文字列だけを置換するようにすれば処理が速くなるのでは?と思いついてできたのが上記のコードでした。

ただ処理速度でいえば 連想配列(Dictionary オブジェクト)と 2次元配列を使った完全一致検索・置換処理コード が速いと思うので、検索・置換処理という用途では使い道はないかもしれません。

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 3

以下、配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 3 です。

VBA サンプルコード 2 では、検索・置換文字列を配列の要素番号の対になるように格納していたので、VBA サンプルコード 1 よりコードが短くなりシンプルになりましたが、置換対象がたくさんあったり追加・変更・削除するといった点ではまだまだ使い勝手はよくありませんでした。

この VBA サンプルコード 3 では検索・置換文字列をあらかじめシート「地方区分置換リスト」にまとめておき、そこから検索・置換文字列を取得することで、コード内に直接検索・置換文字列を設定しておく必要がないようにしています。

次のセクション から VBA サンプルコード 2 から変更点があるコード部分について内容を説明します。

2023// 追記

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

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

Option Explicit

Sub MatchCellReplaceCell4()
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 配列に格納した検索キーワードと書き換え文字列を If 文の条件式で判定

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換4") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換4」をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分置換リスト") ' 検索キーワードと置換キーワードがあるシート「地方区分置換リスト」をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言

'  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
'  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

  ' シート「地方区分置換リスト」の検索キーワードおよび置換キーワードを 2次元配列として動的配列に格納
  regionname1 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索キーワードを最終行までを Range で範囲指定、配列として動的配列にセット
  regionname2 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 2)).Value ' 置換キーワードを最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
      If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
        data1(i, 1) = regionname2(p, 1) ' 配列 data1 の i 行 1列目に、配列 regionname2 の p 行 1 列目に格納してある文字列を代入
      End If
    Next i
  Next p
  
' ----------

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UBound(data1, 1), UBound(data1, 2)).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

シートから検索・置換文字列を取得して 2次元配列に代入

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換4") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換4」をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分置換リスト") ' 検索キーワードと置換キーワードがあるシート「地方区分置換リスト」をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

23行目にオブジェクト変数と Set ステートメントで、検索・置換文字列を記入してあるシート「地方区分置換リスト」を設定します。

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言

'  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
'  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

  ' シート「地方区分置換リスト」の検索キーワードおよび置換キーワードを 2次元配列として動的配列に格納
  regionname1 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索キーワードを最終行までを Range で範囲指定、配列として動的配列にセット
  regionname2 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 2)).Value ' 置換キーワードを最終行までを Range で範囲指定、配列として動的配列にセット

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

51~52行目の Array 関数を使って動的配列に代入した検索・置換文字列をコメントアウトにして、55~56行目でシート「地方区分置換リスト」の指定したセル範囲を 2次元配列に格納します。

シート「地方区分置換リスト」の 1列目には検索文字列を、2列目には置換文字列を設定しているので、動的配列 regionname1 には検索文字列を代入するために Cells プロパティの始点・終点列にシート 1列目の列番号 1 を、動的配列 regionname2 には置換文字列を代入するために Cells プロパティの始点・終点列にシート 2列目の列番号 2 を入れて指定しています。

For ~ If 文と 2次元配列に格納した検索・置換文字列を使って 2次元配列検索(完全一致)置換処理

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
      If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
        data1(i, 1) = regionname2(p, 1) ' 配列 data1 の i 行 1列目に、配列 regionname2 の p 行 1 列目に格納してある文字列を代入
      End If
    Next i
  Next p

上記コードは 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2 の For ~ If 文と 1次元配列に格納した検索・置換文字列を使って 2次元配列検索(完全一致)置換処理 と似ていますが一部変更しています。

配列に検索・置換文字列の設定 から シートから検索・置換文字列を取得して 2次元配列に代入 に変更したので、66行目の 1次元配列 regionname1(p) を 2次元配列 regionname1(p, 1) に、67行目の 1次元配列 regionname2(p) を 2次元配列 regionname2(p, 1) に書き換えています。

1次元配列を 2次元配列用にコードを書き換えたのが主な変更点です。

これで検索・置換文字列をシートで一括管理できるようになった点では便利ですが、こちらの動画 にある通り大量のデータを処理する場合は、処理速度の点からみるとやや時間がかかるようになっているのが弱点です。

処理速度の点から最終的に 連想配列(Dictionary オブジェクト)と 2次元配列 を使うのが、おそらく一番適した処理方法だと思います。

配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 2

以下、配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 2 です。

これは VBA サンプルコード 3 と同じように、シート「地方区分置換リスト」にまとめた検索・置換文字列を使って 配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 1 を一部変更したものとなっています。

配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 1 と同様に使い道はないと思いますが、検索・置換の処理はできるので変更内容を紹介しておきます。

2023// 追記

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

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

Option Explicit

Sub MatchCellReplaceCell5()
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 検索キーワードと書き換え文字列を配列に格納、検索キーワードと完全一致した配列の行番号情報を使って文字列を書き換え

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換5") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換5」をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分置換リスト") ' 検索キーワードと置換キーワードがあるシート「地方区分置換リスト」をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言
  Dim rowsdata1() As Variant ' 地方区分列で検索キーワードがある行番号を配列として格納する動的配列

'  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
'  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

  ' シート「地方区分置換リスト」の検索キーワードおよび置換キーワードを 2次元配列として動的配列に格納
  regionname1 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索キーワードを最終行までを Range で範囲指定、配列として動的配列にセット
  regionname2 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 2)).Value ' 置換キーワードを最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim countrow1 As Long ' 地方区分列で完全一致した検索キーワードの個数を格納する変数

  For p = LBound(regionname1, 1) To UBound(regionname1, 1) ' 配列 regionname1 の 1次元の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    ' 地方区分列にある検索キーワードと完全一致した個数をカウントする処理
    countrow1 = 0 ' 検索キーワード個数カウント用変数 countrow1 の初期化

    ' WorksheetFunction.CountIf メソッドを使って地方区分列にある、検索キーワードと完全一致した個数をカウント
    countrow1 = WorksheetFunction.CountIf(ws1.Range("F:F"), regionname1(p, 1))

    ' WorksheetFunction.CountIf メソッドを使わない場合の For ~ If 文による個数カウント処理
'    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
'      If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
'        countrow1 = countrow1 + 1 ' 検索キーワード完全一致個数カウント用変数 countrow1 をインクリメント(+1)
'      End If
'    Next i

    If countrow1 > 0 Then ' カウントとした検索キーワード個数が 1個以上あれば処理(変数 countrow1(検索キーワード個数)が 0 の場合、次の ReDim ステートメントで countrow1 を指定するとエラーとなるため If 文の条件式で判定)
      ' 地方区分列の検索キーワードがある行番号を、配列 rowsdata1 に格納する処理
      ReDim rowsdata1(1 To countrow1, 1 To 1) ' 変数 rowsdata1 に地方区分列でカウントした検索キーワードの個数を行数とする 2次元配列作成

      k = 0 ' 配列 rowsdata1 用行番号変数の宣言と初期化

      For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
        If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
          k = k + 1 ' 配列 rowsdata1 の行番号 k をインクリメント(+1)
          ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した時のループ処理変数 i(検索キーワードが完全一致した配列の行番号相当)を、配列 rowsdata1 の 行番号 k に代入
          rowsdata1(k, 1) = i
        End If
      Next i

      For i = LBound(rowsdata1, 1) To UBound(rowsdata1, 1) ' 配列 rowsdata1 の 1次元最大要素までループ処理
        data1(rowsdata1(i, 1), 1) = regionname2(p, 1) ' 配列 data1 の rowsdata1(i, 1) 行 1列目に、配列 regionname2 の p 行 1 列目に格納してある文字列を代入
      Next i
    End If

  Next p
  
' ----------

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UBound(data1, 1), UBound(data1, 2)).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

シートから検索・置換文字列を取得して 2次元配列に代入

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換5") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換5」をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分置換リスト") ' 検索キーワードと置換キーワードがあるシート「地方区分置換リスト」をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート
  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言
  Dim rowsdata1() As Variant ' 地方区分列で検索キーワードがある行番号を配列として格納する動的配列

'  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
'  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

  ' シート「地方区分置換リスト」の検索キーワードおよび置換キーワードを 2次元配列として動的配列に格納
  regionname1 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索キーワードを最終行までを Range で範囲指定、配列として動的配列にセット
  regionname2 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 2)).Value ' 置換キーワードを最終行までを Range で範囲指定、配列として動的配列にセット

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

上記コードは 配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 3 のシートから検索・置換文字列を取得して 2次元配列に代入 と同じです。

23行目にオブジェクト変数と Set ステートメントで検索・置換文字列を記入してあるシート「地方区分置換リスト」を設定、55~56行目でシート「地方区分置換リスト」の指定したセル範囲をそれぞれ 2次元配列に検索文字列と置換文字列を格納しています。

2次元配列に格納した検索文字列から行番号取得・置換処理

  ' 変数宣言
  Dim countrow1 As Long ' 地方区分列で完全一致した検索キーワードの個数を格納する変数

  For p = LBound(regionname1, 1) To UBound(regionname1, 1) ' 配列 regionname1 の 1次元の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    ' 地方区分列にある検索キーワードと完全一致した個数をカウントする処理
    countrow1 = 0 ' 検索キーワード個数カウント用変数 countrow1 の初期化

    ' WorksheetFunction.CountIf メソッドを使って地方区分列にある、検索キーワードと完全一致した個数をカウント
    countrow1 = WorksheetFunction.CountIf(ws1.Range("F:F"), regionname1(p, 1))

    ' WorksheetFunction.CountIf メソッドを使わない場合の For ~ If 文による個数カウント処理
'    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
'      If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
'        countrow1 = countrow1 + 1 ' 検索キーワード完全一致個数カウント用変数 countrow1 をインクリメント(+1)
'      End If
'    Next i

    If countrow1 > 0 Then ' カウントとした検索キーワード個数が 1個以上あれば処理(変数 countrow1(検索キーワード個数)が 0 の場合、次の ReDim ステートメントで countrow1 を指定するとエラーとなるため If 文の条件式で判定)
      ' 地方区分列の検索キーワードがある行番号を、配列 rowsdata1 に格納する処理
      ReDim rowsdata1(1 To countrow1, 1 To 1) ' 変数 rowsdata1 に地方区分列でカウントした検索キーワードの個数を行数とする 2次元配列作成

      k = 0 ' 配列 rowsdata1 用行番号変数の宣言と初期化

      For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
        If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
          k = k + 1 ' 配列 rowsdata1 の行番号 k をインクリメント(+1)
          ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した時のループ処理変数 i(検索キーワードが完全一致した配列の行番号相当)を、配列 rowsdata1 の 行番号 k に代入
          rowsdata1(k, 1) = i
        End If
      Next i

      For i = LBound(rowsdata1, 1) To UBound(rowsdata1, 1) ' 配列 rowsdata1 の 1次元最大要素までループ処理
        data1(rowsdata1(i, 1), 1) = regionname2(p, 1) ' 配列 data1 の rowsdata1(i, 1) 行 1列目に、配列 regionname2 の p 行 1 列目に格納してある文字列を代入
      Next i
    End If

  Next p

上記コードは 配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 1 の 1次元配列に格納した検索文字列から行番号取得・置換処理 をそのまま流用して、1次元配列を 2次元配列に書き換えています。

ハイライトしているすべての行にあった 1次元配列の regionname1 および regionname2 を、2次元配列に書き換えています。シート「地方区分置換リスト」から取得した列は 1列だけなので、2次元配列の 2次元はすべて 1 に固定しています。

シート「地方区分置換リスト」のみオブジェクト変数に追加して、残りは 1次元配列を 2次元配列に書き換えただけでうまく動作するようになっています。

連想配列(Dictionary オブジェクト)と 2次元配列を使った高速セル検索(完全一致)置換処理 VBA サンプルコード

以下、連想配列(Dictionary オブジェクト)と 2次元配列を使った高速セル検索(完全一致)置換処理 VBA サンプルコードです。

以前公開した記事 Excel VBA - 連想配列(Dictionary オブジェクト)を使った大量データ高速抽出・集計処理メモ で利用したコードとほぼ同じ内容となっています。

大量のデータに対して大量に検索・置換処理したい場合は、これまで公開した 5種類の VBA コードよりはるかに高速に処理ができるものと思います。

次のセクション から連想配列(Dictionary オブジェクト)と 2次元配列を使った高速セル検索(完全一致)置換処理がある主要な VBA コード部分について内容を説明します。

2023// 追記

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

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

Option Explicit

Sub MatchCellReplaceCell6()
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 連想配列(Dictionary)に登録した検索・置換リストを使って、2次元配列に格納して完全一致した文字列を置換

  ' 実行速度計測開始
  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("地方区分置換リスト") ' 検索先シート(Key, Item)をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換6") ' 検索元シート(Key)をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート

' ----------

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

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

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

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

' ----------

  ' 各シートの指定したセル範囲(Key, Item, 一致したデータ出力先)を配列として格納する動的配列
  Dim data1() As Variant, data2() As Variant, data3() As Variant

  ' 各シートの指定した範囲内セル(Key, Item, 一致したデータ出力先)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value ' 検索先シート(Key, Item)最終行・最終列までを Range で範囲指定、配列として動的配列にセット
  data2 = ws2.Range(ws2.Cells(2, 6), ws2.Cells(maxrow2, 6)).Value ' 検索元シート(Key)最終行までを Range で範囲指定、配列として動的配列にセット
  data3 = ws2.Range(ws2.Cells(2, 7), ws2.Cells(maxrow2, 7)).Value ' 検索元シートの Item データ出力先起点セルから最終行までを Range で範囲指定、配列として動的配列にセット(検索元シート(Key)と一致した検索先シート Item データを格納)

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

' ----------

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

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

' ----------

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

  ' 検索先シートの Key と Item を Dictionary に登録
  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した検索先シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 検索先シート i 行目の 1列目(検索キーワード)を Dictionary 用 Key 変数にセット
    item1 = data1(i, 2) ' 検索先シート i 行目の 2列目(置換キーワード)を Dictionary 用 Item 変数にセット

  ' Key 重複登録判定
    If Not myDic.Exists(key1) Then
      myDic.Add key1, item1 ' 重複していなければ Key, Item 辞書登録
    End If
  Next i

' ----------

  ' 変数宣言
  Dim key2 As String ' Dictionary 用 Key 変数

  ' 検索元シートの Key で検索先シートの Item を取得
  For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
    key2 = data2(i, 1) ' 検索元シート i 行目の 1列目(検索キーワード)を Dictionary 用 Key 変数にセット

    ' 辞書(myDic)から Key を指定して Item を取り出した時の Empty 判定
    If Not IsEmpty(myDic(key2)) Then ' myDic(key2) が Empty ではない場合
      ' 辞書(myDic)から Key(検索元シート i 行目の 1列目(検索キーワード) と一致した Item を、配列 data3 の i 行目の 1列目に格納(置換)
      data3(i, 1) = myDic(key2)
    Else ' myDic(key2) が Empty の場合
      ' 配列 data2 の i 行目の 1列目(地方区分名)を配列 data3 の i 行目の 1列目に格納(置換なし)
      data3(i, 1) = data2(i, 1)
'      data3(i, 1) = key2 ' key2 でも可
    End If
  Next i

' ----------

  ' 動的配列に格納した配列 data3 の Item 内容を、検索元シートの Range で指定したセルから Resize で範囲を変更してセルに代入
  ws2.Range("G2").Resize(UBound(data3, 1), UBound(data3, 2)).Value = data3
  ws2.Activate

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

' ----------

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

End Sub

シートから検索・置換文字列を取得して 2次元配列に代入

  ' 各シートの指定したセル範囲(Key, Item, 一致したデータ出力先)を配列として格納する動的配列
  Dim data1() As Variant, data2() As Variant, data3() As Variant

  ' 各シートの指定した範囲内セル(Key, Item, 一致したデータ出力先)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value ' 検索先シート(Key, Item)最終行・最終列までを Range で範囲指定、配列として動的配列にセット
  data2 = ws2.Range(ws2.Cells(2, 6), ws2.Cells(maxrow2, 6)).Value ' 検索元シート(Key)最終行までを Range で範囲指定、配列として動的配列にセット
  data3 = ws2.Range(ws2.Cells(2, 7), ws2.Cells(maxrow2, 7)).Value ' 検索元シートの Item データ出力先起点セルから最終行までを Range で範囲指定、配列として動的配列にセット(検索元シート(Key)と一致した検索先シート Item データを格納)

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

検索・置換対象のシートと検索・置換文字列リストがあるシートの指定したセル範囲を 2次元配列に格納します。

動的配列 data1 にはシート「地方区分置換リスト」の検索・置換文字列リストを格納、動的配列 data2 には検索・置換対象の文字列を格納、動的配列 data3 には置換後の文字列を一時的に格納するため、転記先のセルを指定して配列を確保しています。

連想配列(Dictionary オブジェクト)にキー(検索文字列)・アイテム(置換文字列)登録

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

  ' 検索先シートの Key と Item を Dictionary に登録
  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した検索先シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 検索先シート i 行目の 1列目(検索キーワード)を Dictionary 用 Key 変数にセット
    item1 = data1(i, 2) ' 検索先シート i 行目の 2列目(置換キーワード)を Dictionary 用 Item 変数にセット

  ' Key 重複登録判定
    If Not myDic.Exists(key1) Then
      myDic.Add key1, item1 ' 重複していなければ Key, Item 辞書登録
    End If
  Next i

連想配列(Dictionary オブジェクト)を使ってシート「地方区分置換リスト」にある検索・置換文字列を、キーに検索文字列を、アイテムに置換文字列を辞書登録します。

75 ~ 76行目に連想配列(Dictionary オブジェクト)用のキー変数とアイテム変数を宣言します。キー変数およびアイテム変数ともに String 型です。

79行目の For 文と LBound・UBound 関数で、辞書登録対象の 2次元配列 data1 の 1次元最大要素(行相当)までループ処理します。

80行目でキー変数に 2次元配列 data1(i, 1) にある検索文字列を代入します。81行目でも同様にアイテム変数に 2次元配列 data1(i, 2) にある置換文字列を代入します。

84行目の If Not 文と Dictionary オブジェクトの Exists メソッドを組み合わせてキーの重複判定を行い、キーの重複がなければ 85行目で Dictionary オブジェクトの Add メソッドでキーとアイテムを登録します。

連想配列(Dictionary オブジェクト)から検索キー(置換対象文字列)を使ってアイテム(置換文字列)取得

  ' 変数宣言
  Dim key2 As String ' Dictionary 用 Key 変数

  ' 検索元シートの Key で検索先シートの Item を取得
  For i = LBound(data2, 1) To UBound(data2, 1) ' 配列に格納した検索元シートの 1次元最大要素までループ処理
    key2 = data2(i, 1) ' 検索元シート i 行目の 1列目(検索キーワード)を Dictionary 用 Key 変数にセット

    ' 辞書(myDic)から Key を指定して Item を取り出した時の Empty 判定
    If Not IsEmpty(myDic(key2)) Then ' myDic(key2) が Empty ではない場合
      ' 辞書(myDic)から Key(検索元シート i 行目の 1列目(検索キーワード) と一致した Item を、配列 data3 の i 行目の 1列目に格納(置換)
      data3(i, 1) = myDic(key2)
    Else ' myDic(key2) が Empty の場合
      ' 配列 data2 の i 行目の 1列目(地方区分名)を配列 data3 の i 行目の 1列目に格納(置換なし)
      data3(i, 1) = data2(i, 1)
'      data3(i, 1) = key2 ' 96行目の変数 key2 でも可
    End If
  Next i

キー・アイテム登録した連想配列(Dictionary オブジェクト) から検索キーを使ってアイテムを取得して、検索対象文字列の置換処理を行います。

96行目の 2次元配列 data2(1, 1) から検索対象文字列を代入したキー変数 key2 使って、99行目の If Not 文と IsEmpty 関数で 辞書(myDic) を参照した場合にアイテムが Empty かどうかを判定します。

myDic(key2) でアイテムが Empty でなければ、101行目で myDic(key2) で参照したアイテムを、置換処理結果一時格納 2次元配列 data3(i, 1) に格納します。これがセル内容の置換処理相当になります。

myDic(key2) でアイテムが Empty であれば、104行目で検索対象文字列を格納した 2次元配列 data2(i, 1) を、置換処理結果一時格納 2次元配列 data3(i, 1) に格納します。

置換対象の文字列がなかったことになるので、96行目に登場した検索対象文字列 data2(i, 1) をそのまま代入しているだけとなっています。なお、105行目のように 96行目に検索対象文字列を代入した変数 key2 を使っても同じ処理結果になります。

以上が連想配列(Dictionary オブジェクト)と 2次元配列を使った高速セル検索(完全一致)置換処理内容になります。

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

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

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

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

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

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

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 1 メモリリーク対策版

Option Explicit

Sub MatchCellReplaceCell1FixMemoryLeaks1() ' メモリリーク対策版
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' If 文による条件式のみ

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換1") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換1」をオブジェクト変数にセット
'  Set ws2 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' If 文でキーワード検索・完全一致した場合、別の文字列に書き換え

  ' 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)

  For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "関東地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「関東地方」が完全一致した場合
      data1(i, 1) = "Kanto Region" ' 配列 data1 の i 行 1列目に文字列 Kanto Region を代入
    End If
  Next i

  For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "四国地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「四国地方」が完全一致した場合
      data1(i, 1) = "Shikoku Region" ' 配列 data1 の i 行 1列目に文字列 Shikoku Region を代入
    End If
  Next i

  For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
    If data1(i, 1) = "関西地方" Then ' 配列 data1 の i 行 1列目のデータが、地方区分列の「関西地方」が完全一致した場合
      data1(i, 1) = "Kasai Region" ' 配列 data1 の i 行 1列目に文字列 Kasai Region を代入
    End If
  Next i

' ----------

  ' UBound 関数格納用変数と代入(メモリリーク対策)
  Dim UB_data1_2D As Variant
  UB_data1_2D = UBound(data1, 2)

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UB_data1_1D, UB_data1_2D).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 2 メモリリーク対策版

Option Explicit

Sub MatchCellReplaceCell2FixMemoryLeaks1() ' メモリリーク対策版
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 配列に格納した検索キーワードと書き換え文字列を If 文の条件式で判定

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換2") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換2」をオブジェクト変数にセット
'  Set ws2 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言

  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

' ----------

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

  For p = LB_regionname1 To UB_regionname1 ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
      If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
        data1(i, 1) = regionname2(p) ' 配列 data1 の i 行 1列目に、配列 regionname2 の要素番号 p に格納してある文字列を代入
      End If
    Next i
  Next p

' ----------

  ' UBound 関数格納用変数と代入(メモリリーク対策)
  Dim UB_data1_2D As Variant
  UB_data1_2D = UBound(data1, 2)

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UB_data1_1D, UB_data1_2D).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

配列を使ったセル検索(完全一致)置換処理 VBA サンプルコード 3 メモリリーク対策版

Option Explicit

Sub MatchCellReplaceCell4FixMemoryLeaks1() ' メモリリーク対策版
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 配列に格納した検索キーワードと書き換え文字列を If 文の条件式で判定

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換4") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換4」をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分置換リスト") ' 検索キーワードと置換キーワードがあるシート「地方区分置換リスト」をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言

'  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
'  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

  ' シート「地方区分置換リスト」の検索キーワードおよび置換キーワードを 2次元配列として動的配列に格納
  regionname1 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索キーワードを最終行までを Range で範囲指定、配列として動的配列にセット
  regionname2 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 2)).Value ' 置換キーワードを最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

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

  For p = LBound(regionname1) To UBound(regionname1) ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    For i = LBound(data1, 1) To UBound(data1, 1) ' 配列 data1 の 1次元最大要素までループ処理
      If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
        data1(i, 1) = regionname2(p, 1) ' 配列 data1 の i 行 1列目に、配列 regionname2 の p 行 1 列目に格納してある文字列を代入
      End If
    Next i
  Next p
  
' ----------

  ' UBound 関数格納用変数と代入(メモリリーク対策)
  Dim UB_data1_2D As Variant
  UB_data1_2D = UBound(data1, 2)

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UB_data1_1D, UB_data1_2D).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 1 メモリリーク対策版

Option Explicit

Sub MatchCellReplaceCell3FixMemoryLeaks1() ' メモリリーク対策版
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 検索キーワードと書き換え文字列を配列に格納、検索キーワードと完全一致した配列の行番号情報を使って文字列を書き換え

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換3") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換3」をオブジェクト変数にセット
'  Set ws2 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
'  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言
  Dim rowsdata1() As Variant ' 地方区分列で検索キーワードがある行番号を配列として格納する動的配列

  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

' ----------

  ' 変数宣言
  Dim countrow1 As Long ' 地方区分列で完全一致した検索キーワードの個数を格納する変数

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_regionname1 As Variant, UB_regionname1 As Variant
'  Dim LB_regionname2 As Variant, UB_regionname2 As Variant
  Dim LB_data1_1D As Variant, UB_data1_1D As Variant
  Dim LB_rowsdata1_1D As Variant, UB_rowsdata1_1D As Variant
  LB_regionname1 = LBound(regionname1)
  UB_regionname1 = UBound(regionname1)
'  LB_regionname2 = LBound(regionname2)
'  UB_regionname2 = UBound(regionname2)
  LB_data1_1D = LBound(data1, 1)
  UB_data1_1D = UBound(data1, 1)

  For p = LB_regionname1 To UB_regionname1 ' 配列 regionname1 の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    ' 地方区分列にある検索キーワードと完全一致した個数をカウントする処理
    countrow1 = 0 ' 検索キーワード個数カウント用変数 countrow1 の初期化

    ' WorksheetFunction.CountIf メソッドを使って地方区分列にある、検索キーワードと完全一致した個数をカウント
    countrow1 = WorksheetFunction.CountIf(ws1.Range("F:F"), regionname1(p))

    ' WorksheetFunction.CountIf メソッドを使わない場合の For ~ If 文による個数カウント処理
'    For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
'      If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
'        countrow1 = countrow1 + 1 ' 検索キーワード完全一致個数カウント用変数 countrow1 をインクリメント(+1)
'      End If
'    Next i

    If countrow1 > 0 Then ' カウントとした検索キーワード個数が 1個以上あれば処理(変数 countrow1(検索キーワード個数)が 0 の場合、次の ReDim ステートメントで countrow1 を指定するとエラーとなるため If 文の条件式で判定)
      ' 地方区分列の検索キーワードがある行番号を、配列 rowsdata1 に格納する処理
      ReDim rowsdata1(1 To countrow1, 1 To 1) ' 変数 rowsdata1 に地方区分列でカウントした検索キーワードの個数を行数とする 2次元配列作成

      k = 0 ' 配列 rowsdata1 用行番号変数の宣言と初期化

      For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
        If data1(i, 1) = regionname1(p) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した場合
          k = k + 1 ' 配列 rowsdata1 の行番号 k をインクリメント(+1)
          ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した時のループ処理変数 i(検索キーワードが完全一致した配列の行番号相当)を、配列 rowsdata1 の 行番号 k に代入
          rowsdata1(k, 1) = i
        End If
      Next i

      ' LBound・UBound 関数格納用変数に代入(メモリリーク対策)
      LB_rowsdata1_1D = LBound(rowsdata1, 1)
      UB_rowsdata1_1D = UBound(rowsdata1, 1)

      For i = LB_rowsdata1_1D To UB_rowsdata1_1D ' 配列 rowsdata1 の 1次元最大要素までループ処理
        data1(rowsdata1(i, 1), 1) = regionname2(p) ' 配列 data1 の rowsdata1(i, 1) 行 1列目に、配列 regionname2 の要素番号 p に格納してある文字列を代入
      Next i
    End If

  Next p
  
' ----------

  ' UBound 関数格納用変数と代入(メモリリーク対策)
  Dim UB_data1_2D As Variant
  UB_data1_2D = UBound(data1, 2)

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UB_data1_1D, UB_data1_2D).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

配列を使った行番号取得・セル検索(完全一致)置換処理 VBA サンプルコード 2 メモリリーク対策版

Option Explicit

Sub MatchCellReplaceCell5FixMemoryLeaks1() ' メモリリーク対策版
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 検索キーワードと書き換え文字列を配列に格納、検索キーワードと完全一致した配列の行番号情報を使って文字列を書き換え

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

' ----------

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

' ----------

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

  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換5") ' 地方区分列があるシート「都道府県県庁所在地地方区分ランダム並べ替え地方区分置換5」をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("地方区分置換リスト") ' 検索キーワードと置換キーワードがあるシート「地方区分置換リスト」をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' データ出力先テスト用シート

' ----------

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

' ----------

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

  ' シートの指定した範囲内セル(キーワード列)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 6), ws1.Cells(maxrow1, 6)).Value ' 検索対象キーワードがある列の最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim regionname1() As Variant, regionname2() As Variant ' 検索キーワードと書き換える文字列を格納する動的配列を宣言
  Dim rowsdata1() As Variant ' 地方区分列で検索キーワードがある行番号を配列として格納する動的配列

'  regionname1 = Array("関東地方", "四国地方", "関西地方") ' 検索キーワードを Array 関数で動的配列に代入
'  regionname2 = Array("Kanto Region", "Shikoku Region", "Kasai Region") ' 検索キーワードに完全一致した場合に書き換える文字列を Array 関数で動的配列に代入

  ' シート「地方区分置換リスト」の検索キーワードおよび置換キーワードを 2次元配列として動的配列に格納
  regionname1 = ws2.Range(ws2.Cells(2, 1), ws2.Cells(maxrow2, 1)).Value ' 検索キーワードを最終行までを Range で範囲指定、配列として動的配列にセット
  regionname2 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 2)).Value ' 置換キーワードを最終行までを Range で範囲指定、配列として動的配列にセット

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

' ----------

  ' 変数宣言
  Dim countrow1 As Long ' 地方区分列で完全一致した検索キーワードの個数を格納する変数

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_regionname1 As Variant, UB_regionname1 As Variant
'  Dim LB_regionname2 As Variant, UB_regionname2 As Variant
  Dim LB_data1_1D As Variant, UB_data1_1D As Variant
  Dim LB_rowsdata1_1D As Variant, UB_rowsdata1_1D As Variant
  LB_regionname1 = LBound(regionname1, 1)
  UB_regionname1 = UBound(regionname1, 1)
'  LB_regionname2 = LBound(regionname2,1)
'  UB_regionname2 = UBound(regionname2,1)
  LB_data1_1D = LBound(data1, 1)
  UB_data1_1D = UBound(data1, 1)

  For p = LB_regionname1 To UB_regionname1 ' 配列 regionname1 の 1次元の最大要素までループ処理(配列 regionname2 でも可(どちらの配列も要素数が同じため))
    ' 地方区分列にある検索キーワードと完全一致した個数をカウントする処理
    countrow1 = 0 ' 検索キーワード個数カウント用変数 countrow1 の初期化

    ' WorksheetFunction.CountIf メソッドを使って地方区分列にある、検索キーワードと完全一致した個数をカウント
    countrow1 = WorksheetFunction.CountIf(ws1.Range("F:F"), regionname1(p, 1))

    ' WorksheetFunction.CountIf メソッドを使わない場合の For ~ If 文による個数カウント処理
'    For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
'      If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
'        countrow1 = countrow1 + 1 ' 検索キーワード完全一致個数カウント用変数 countrow1 をインクリメント(+1)
'      End If
'    Next i

    If countrow1 > 0 Then ' カウントとした検索キーワード個数が 1個以上あれば処理(変数 countrow1(検索キーワード個数)が 0 の場合、次の ReDim ステートメントで countrow1 を指定するとエラーとなるため If 文の条件式で判定)
      ' 地方区分列の検索キーワードがある行番号を、配列 rowsdata1 に格納する処理
      ReDim rowsdata1(1 To countrow1, 1 To 1) ' 変数 rowsdata1 に地方区分列でカウントした検索キーワードの個数を行数とする 2次元配列作成

      k = 0 ' 配列 rowsdata1 用行番号変数の宣言と初期化

      For i = LB_data1_1D To UB_data1_1D ' 配列 data1 の 1次元最大要素までループ処理
        If data1(i, 1) = regionname1(p, 1) Then ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の p 行 1 列目に格納してある文字列と完全一致した場合
          k = k + 1 ' 配列 rowsdata1 の行番号 k をインクリメント(+1)
          ' 配列 data1 の i 行 1列目のデータが、配列 regionname1 の要素番号 p に格納してある文字列と完全一致した時のループ処理変数 i(検索キーワードが完全一致した配列の行番号相当)を、配列 rowsdata1 の 行番号 k に代入
          rowsdata1(k, 1) = i
        End If
      Next i

      ' LBound・UBound 関数格納用変数に代入(メモリリーク対策)
      LB_rowsdata1_1D = LBound(rowsdata1, 1)
      UB_rowsdata1_1D = UBound(rowsdata1, 1)

      For i = LB_rowsdata1_1D To UB_rowsdata1_1D ' 配列 rowsdata1 の 1次元最大要素までループ処理
        data1(rowsdata1(i, 1), 1) = regionname2(p, 1) ' 配列 data1 の rowsdata1(i, 1) 行 1列目に、配列 regionname2 の p 行 1 列目に格納してある文字列を代入
      Next i
    End If

  Next p
  
' ----------

  ' UBound 関数格納用変数と代入(メモリリーク対策)
  Dim UB_data1_2D As Variant
  UB_data1_2D = UBound(data1, 2)

  ' 二次元配列 data2 の内容を、Range で指定したセルから Resize で範囲を変更してセルに代入
  ws1.Range("G2").Resize(UB_data1_1D, UB_data1_2D).Value = data1
  ws1.Activate

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

' ----------

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

End Sub

連想配列(Dictionary オブジェクト)と 2次元配列を使った高速セル検索(完全一致)置換処理 VBA サンプルコード メモリリーク対策版

Option Explicit

Sub MatchCellReplaceCell6FixMemoryLeaks1() ' メモリリーク対策版
  ' 地方区分列から指定したキーワードに完全一致した配列を取得して書き換え
  ' 連想配列(Dictionary)に登録した検索・置換リストを使って、2次元配列に格納して完全一致した文字列を置換

  ' 実行速度計測開始
  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("地方区分置換リスト") ' 検索先シート(Key, Item)をオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分ランダム並べ替え地方区分置換6") ' 検索元シート(Key)をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート

' ----------

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

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

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

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

' ----------

  ' 各シートの指定したセル範囲(Key, Item, 一致したデータ出力先)を配列として格納する動的配列
  Dim data1() As Variant, data2() As Variant, data3() As Variant

  ' 各シートの指定した範囲内セル(Key, Item, 一致したデータ出力先)を配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value ' 検索先シート(Key, Item)最終行・最終列までを Range で範囲指定、配列として動的配列にセット
  data2 = ws2.Range(ws2.Cells(2, 6), ws2.Cells(maxrow2, 6)).Value ' 検索元シート(Key)最終行までを Range で範囲指定、配列として動的配列にセット
  data3 = ws2.Range(ws2.Cells(2, 7), ws2.Cells(maxrow2, 7)).Value ' 検索元シートの Item データ出力先起点セルから最終行までを Range で範囲指定、配列として動的配列にセット(検索元シート(Key)と一致した検索先シート Item データを格納)

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

' ----------

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

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data3_1D As Variant, UB_data3_1D As Variant
  Dim LB_data3_2D As Variant, UB_data3_2D As Variant
  LB_data3_1D = LBound(data3, 1)
  UB_data3_1D = UBound(data3, 1)
  LB_data3_2D = LBound(data3, 2)
  UB_data3_2D = UBound(data3, 2)

  For i = LB_data3_1D To UB_data3_1D ' 1次元最大要素までループ処理
    For k = LB_data3_2D To UB_data3_2D ' 2次元最大要素までループ処理
      data3(i, k) = Empty ' 配列に Empty を代入して初期化
    Next k
'    data3(i, 1) = Empty ' for 文を使わない場合の書き方
'    data3(i, 2) = Empty ' for 文を使わない場合の書き方
  Next i

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

' ----------

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

  ' 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)

  ' 検索先シートの Key と Item を Dictionary に登録
  For i = LB_data1_1D To UB_data1_1D ' 配列に格納した検索先シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 検索先シート i 行目の 1列目(検索キーワード)を Dictionary 用 Key 変数にセット
    item1 = data1(i, 2) ' 検索先シート i 行目の 2列目(置換キーワード)を Dictionary 用 Item 変数にセット

  ' Key 重複登録判定
    If Not myDic.Exists(key1) Then
      myDic.Add key1, item1 ' 重複していなければ Key, Item 辞書登録
    End If
  Next i

' ----------

  ' 変数宣言
  Dim key2 As String ' Dictionary 用 Key 変数

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

  ' 検索元シートの Key で検索先シートの Item を取得
  For i = LB_data2_1D To UB_data2_1D ' 配列に格納した検索元シートの 1次元最大要素までループ処理
    key2 = data2(i, 1) ' 検索元シート i 行目の 1列目(検索キーワード)を Dictionary 用 Key 変数にセット

    ' 辞書(myDic)から Key を指定して Item を取り出した時の Empty 判定
    If Not IsEmpty(myDic(key2)) Then ' myDic(key2) が Empty ではない場合
      ' 辞書(myDic)から Key(検索元シート i 行目の 1列目(検索キーワード) と一致した Item を、配列 data3 の i 行目の 1列目に格納(置換)
      data3(i, 1) = myDic(key2)
    Else ' myDic(key2) が Empty の場合
      ' 配列 data1 の i 行目の 1列目(地方区分名)を配列 data3 の i 行目の 1列目に格納(置換なし)
      data3(i, 1) = data2(i, 1)
'      data3(i, 1) = key2 ' 96行目の変数 key2 でも可
    End If
  Next i

' ----------

  ' 動的配列に格納した配列 data3 の Item 内容を、検索元シートの Range で指定したセルから Resize で範囲を変更してセルに代入
  ws2.Range("G2").Resize(UB_data3_1D, UB_data3_2D).Value = data3
  ws2.Activate

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

' ----------

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

End Sub