Excel VBA - 配列を使った列高速入れ替え処理メモ

2023年08月21日

2023年09月21日

0 コメント

Excel VBA で配列を使って列を入れ替える VBA コードを公開します。

Excel と Excel Visual Basic Editor（VBE）の環境設定については以前公開した記事より、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 キー）画面から（オブジェクト名）欄を設定するのが前提となっています。

今回記事内で紹介する列入れ替え処理について、2種類の配列を使って列を入れ替える VBA コードを公開します。いずれも処理結果は同じになります。VBA コードの詳細な内容については各セクション（VBA サンプルコード 1、VBA サンプルコード 2）で説明します。

2023/9/21 追記

連想配列（Dictionary オブジェクト）を使わない VBA サンプルコード 3 を公開しました。シート内すべての列を指定した順番に単純に入れ替えたい場合はこちらの VBA コードが短くて使いやすいと思います。

目次へ戻る↑

配列を使った列入れ替え処理 VBA サンプルコード 1

以下、配列を使った列入れ替え処理 VBA サンプルコード 1 です。

基本的に以前公開した連想配列（Dictionary オブジェクト）大量データ高速抽出処理 VBA サンプルコード 3 に列入れ替え処理用のコードを追加・変更した内容となっています。

この VBA コードはシート「都道府県県庁所在地地方区分抽出列入れ替え1」の都道府県コード（1 ～ 47）を検索キーとして、シート「都道府県県庁所在地地方区分ランダム並べ替え」にある、ランダムに並べ替えられた各都道府県データから検索キーと一致するデータ（都道府県、Prefectures、県庁所在地、Capital、地方区分）を抽出します。ここまでは連想配列（Dictionary オブジェクト）大量データ高速抽出処理 VBA サンプルコード 3 と同じです。

抽出した都道府県データをシート「都道府県県庁所在地地方区分抽出列入れ替え1」の各都道府県コードに対応するセルに反映（転記）しますが、ここで各列を指定した順番に配列を使って入れ替えます。そのため、シート「都道府県県庁所在地地方区分抽出列入れ替え1」の列名はあらかじめ空白にしています。

あと、抽出したデータの反映先がわかりやすいように、あらかじめ該当セルを罫線で囲んでいます。

わざわざ VBA の配列を使って列を入れ替える理由ですが、データ件数が少なければシート上での列操作（参考情報）や VBA を使った列の Cut & Insert（参考情報 1、参考情報 2、参考情報 3）で十分ですが、データ件数が多くなると上記列操作では処理時間が長くなってしまう欠点があります。

おそらく、Excel のシート上に大量のデータがある状態では、セル操作をするのに向いていないような気がします。

この VBA コードは並べ替え対象の列名を、並べ替えたい順番に配列に格納して、列名から列番号に変換、連想配列（Dictionary オブジェクト）で抽出したデータを 2次元配列に格納する際に、配列に格納した列番号の順番に従ってデータを格納して、列を入れ替えるというものです。

これによりシート上の列を操作することなく、結果的に VBA の配列を使うことで列を並べ替えることが実現できるということになります。単に配列上でデータを入れ替える順番を変更しているだけなので、高速に処理できます。

次のセクションから配列を使った列の入れ替え処理に関係があるコード部分に絞って内容を説明します。

配列を使った列入れ替え処理 VBA サンプルコード 1（クリックで開閉）

Option Explicit

Sub MatchDictPrefCodeSortColumns1()
  ' 連想配列（Dictionary）と配列を使ってシート「都道府県県庁所在地地方区分抽出列入れ替え1」の都道府県コードをキーにして、
  ' シート「都道府県県庁所在地地方区分ランダム並べ替え」から都道府県、Prefectures、県庁所在地、Capital、地方区分を取得して列を入れ替え

  ' 実行速度計測開始
  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("都道府県県庁所在地地方区分抽出列入れ替え1") ' 検索元シート（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(1, 1), ws1.Cells(maxrow1, maxcol1)).Value ' 検索先シート（Key, Item）最終行・最終列までを Range で範囲指定、配列として動的配列にセット
  data2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(maxrow2, 1)).Value ' 検索元シート（Key）最終行までを Range で範囲指定、配列として動的配列にセット
  data3 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(maxrow2, 6)).Value ' 検索元シートの Item データ出力先起点セルから最終行・最終列までを Range で範囲指定、配列として動的配列にセット（検索元シート（Key）と一致した検索先シート Item データを格納）

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

' ----------

  ' 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 文を使わない場合の書き方
'    data3(i, 3) = Empty ' for 文を使わない場合の書き方
'    data3(i, 4) = Empty ' for 文を使わない場合の書き方
'    data3(i, 5) = Empty ' for 文を使わない場合の書き方
  Next i

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

' ----------

  ' 変数宣言
  Dim arr1() As Variant ' 1次元配列格納用動的配列宣言
  arr1 = Array("F", "C", "E", "B", "D") ' Array 関数の要素に配列 data1（検索先シート）の並べ替え対象列名を、並べ替えたい順番に配列先頭から代入

  For i = LBound(arr1) To UBound(arr1) ' 1次元配列最大要素までループ処理
    arr1(i) = Columns(arr1(i)).Column ' 列名を列番号に変換
  Next i

' ----------

  ' 変数宣言
  Dim myDic As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
  Set myDic = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
  Dim key1 As String ' Dictionary 用 Key 変数
  Dim row1 As Variant ' Dictionary 用 Item 変数（Key がある配列の行番号

  ' 検索先シートの Key と Item を Dictionary に登録
  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した検索先シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 検索先シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
    row1 = i ' Key がある配列の行番号格納

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

' ----------

  ' 変数宣言
  Dim key2 As String ' Dictionary 用 Key 変数
  Dim row2 As Long ' Dictionary 用 Item 変数（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 ではない場合
      row2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード）） と一致した Item を変数に格納

      For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
        data3(i, k) = data1(row2, arr1(k - 1)) ' 配列 data1 の row2 行 arr1(k - 1) 列目（配列 arr1 の要素番号 k - 1 にある列番号）を、配列 data3 の i 行 k 列目に格納
      Next k
'      data3(i, 1) = data1(row2, arr1(0)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(0) 列目（配列 arr1 の要素番号 0 に格納された値）
'      data3(i, 2) = data1(row2, arr1(1)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(1) 列目（配列 arr1 の要素番号 1 に格納された値）
'      data3(i, 3) = data1(row2, arr1(2)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(2) 列目（配列 arr1 の要素番号 2 に格納された値）
'      data3(i, 4) = data1(row2, arr1(3)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(3) 列目（配列 arr1 の要素番号 3 に格納された値）
'      data3(i, 5) = data1(row2, arr1(4)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(4) 列目（配列 arr1 の要素番号 4 に格納された値）
    Else ' myDic(key2) が Empty の場合
      For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
        data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
      Next k
'      data3(i, 1) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 2) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 3) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 4) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 5) = "*****" ' for 文を使わない場合の書き方
    End If
  Next i

' ----------

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

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

' ----------

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

End Sub

Excel VBA - 連想配列（Dictionary オブジェクト）を使った大量データ高速抽出・集計処理メモ → 連想配列（Dictionary オブジェクト）大量データ高速抽出処理 VBA サンプルコード 3（条件エラー改善版、大量データ抽出処理〇）

目次へ戻る↑

各シートのセル範囲を指定してセル値をまとめて 2次元配列に格納（全セル対象）

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

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

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

47～49行目のセル範囲の取得に使う Range プロパティの範囲指定で、開始セルの Cells プロパティを 2行目から 1行目に変更しています。

これは連想配列（Dictionary オブジェクト）では見出しを除く検索キーがある行から指定する形（シート 1行目に見出しがある場合は 2行目から）だったところ、見出しも含めて列を入れ替えするため、1行目もキーとアイテムとして扱います。

今回のサンプルデータの場合、セル A1 にある「都道府県コード」がキーに、セル B1 ～ F1 がアイテムに含まれることになります。

目次へ戻る↑

配列を使って入れ替え対象列名の設定と列順番セット＆列番号変換

  ' 変数宣言
  Dim arr1() As Variant ' 1次元配列格納用動的配列宣言
  arr1 = Array("F", "C", "E", "B", "D") ' Array 関数の要素に配列 data1（検索先シート）の並べ替え対象列名を、並べ替えたい順番に配列先頭から代入

  For i = LBound(arr1) To UBound(arr1) ' 1次元配列最大要素までループ処理
    arr1(i) = Columns(arr1(i)).Column ' 列名を列番号に変換
  Next i

配列に入れ替え対象の列名（アルファベット）をセットして列番号に変換します。ちなみに最初から列番号を指定するのであれば 79 ～ 81行目の列番号変換処理は不要です。

76行目に配列として格納するための変数をバリアント型（Variant）の動的配列として宣言します。

77行目で Array 関数を使って入れ替え対象のすべてのアルファベット列名を文字列として、入れ替えたい列名順にセットします。ここでは B → C → D → E → F 列から F → C → E → B → D 列順に設定。

今回のサンプルデータの場合は B ～ F 列までが列入れ替え対象となっています。A 列は連想配列（Dictionary オブジェクト）に必要な検索キーの都道府県コードのため、入れ替え対象外となっており A 列は含まれていません。

79 行目に For 文と LBound・UBound 関数で、アルファベット列名を文字列として格納した 1次元配列 arr1 の最小～最大要素までループ処理します。

80行目の For 文内で、Columns プロパティに 1次元配列 arr1 のカウンタ変数 i 番目の要素に格納されている文字列のアルファベット列名を指定します。続く Column プロパティで列番号を取得して、それを左辺で再び 1次元配列 arr1 の i 番目に格納します。これですべてのアルファベット列名を列番号に変換できます。

アルファベット列名から列番号に変換して格納した 1次元配列 arr1 を、この後の配列に格納した指定した列順番に従って 2次元配列でデータ入れ替え処理で、2次元配列の 2次元の要素番号指定に使用します。

目次へ戻る↑

配列に格納した指定した列順番に従って 2次元配列でデータ入れ替え

  ' 変数宣言
  Dim key2 As String ' Dictionary 用 Key 変数
  Dim row2 As Long ' Dictionary 用 Item 変数（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 ではない場合
      row2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード）） と一致した Item を変数に格納

      For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
        data3(i, k) = data1(row2, arr1(k - 1)) ' 配列 data1 の row2 行 arr1(k - 1) 列目（配列 arr1 の要素番号 k - 1 にある列番号）を、配列 data3 の i 行 k 列目に格納
      Next k
'      data3(i, 1) = data1(row2, arr1(0)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(0) 列目（配列 arr1 の要素番号 0 に格納された値）
'      data3(i, 2) = data1(row2, arr1(1)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(1) 列目（配列 arr1 の要素番号 1 に格納された値）
'      data3(i, 3) = data1(row2, arr1(2)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(2) 列目（配列 arr1 の要素番号 2 に格納された値）
'      data3(i, 4) = data1(row2, arr1(3)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(3) 列目（配列 arr1 の要素番号 3 に格納された値）
'      data3(i, 5) = data1(row2, arr1(4)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(4) 列目（配列 arr1 の要素番号 4 に格納された値）
    Else ' myDic(key2) が Empty の場合
      For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
        data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
      Next k
'      data3(i, 1) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 2) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 3) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 4) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 5) = "*****" ' for 文を使わない場合の書き方
    End If
  Next i

' ----------

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

入れ替え対象のアルファベット列名から変換した列番号を使って列の入れ替え処理をします。

連想配列（Dictionary オブジェクト）から検索キーを使ってアイテムを取得するコード部分ですが、以前公開した連想配列（Dictionary オブジェクト）大量データ高速抽出処理 VBA サンプルコード 3 とほぼ同じコード内容です。

変更点は以下の 2点です。

117行目の For 文内でカウンタ変数 k を使って、キーとアイテムが格納されている 2次元配列 data1 にあるアイテムを取得します。

2次元配列 data1 の 2次元の要素には列番号を格納した 1次元配列 arr1 をセット、配列 arr1 の要素番号はカウンタ変数 k を使って指定しています。

配列 arr1 の要素番号に使用したカウンタ変数 k に - 1 をしているのは、1次元配列 arr1 の開始要素番号は 0 からなので、カウンタ変数 k の初期値 1 を - 1（arr1(1 - 1)）とすることで arr1(0) となるように調整しているためです。

139行目の Range オブジェクトでデータ転記先の開始セルを見出しがあるセル B2 から B1 に変更しています。これはセル A1 をキーにしたアイテムの見出し名が 2次元配列 data3 に含まれているため、それにあわせて開始セルを見出し名セル B1 からを指定しています。

目次へ戻る↑

配列を使った列入れ替え処理 VBA サンプルコード 2

以下、配列を使った列入れ替え処理 VBA サンプルコード 2 です。

基本的に配列を使った列入れ替え処理 VBA サンプルコード 1 と同じです。

大きな相違点として列の入れ替え処理を、見出しとそれ以外のデータ部分の 2つに処理を分けています。そのためコードが長くなっています。

VBA サンプルコード 1 のほうがコードが短くシンプルなのでこれで十分かと思いますが、見出し部分とデータ部分の列入れ替えを意図的に処理を分けるといったことが、コードの書き方次第で可能となっています。

次のセクションから追加・変更したコード部分について説明します。

配列を使った列入れ替え処理 VBA サンプルコード 2（クリックで開閉）

Option Explicit

Sub MatchDictPrefCodeSortColumns2()
  ' 連想配列（Dictionary）と配列を使ってシート「都道府県県庁所在地地方区分抽出列入れ替え2」の都道府県コードをキーにして、
  ' シート「都道府県県庁所在地地方区分ランダム並べ替え」から都道府県、Prefectures、県庁所在地、Capital、地方区分を取得して列を入れ替え

  ' 実行速度計測開始
  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("都道府県県庁所在地地方区分抽出列入れ替え2") ' 検索元シート（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, 1), ws2.Cells(maxrow2, 1)).Value ' 検索元シート（Key）最終行までを Range で範囲指定、配列として動的配列にセット
  data3 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)).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, 1), ws2.Cells(maxrow2, 1)))
'  data3 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)))

' ----------

  ' 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 文を使わない場合の書き方
'    data3(i, 3) = Empty ' for 文を使わない場合の書き方
'    data3(i, 4) = Empty ' for 文を使わない場合の書き方
'    data3(i, 5) = Empty ' for 文を使わない場合の書き方
  Next i

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

' ----------

  ' 変数宣言
  Dim arr1() As Variant ' 1次元配列格納用動的配列宣言
  arr1 = Array("F", "C", "E", "B", "D") ' Array 関数の要素に配列 data1（検索先シート）の並べ替え対象列名を、並べ替えたい順番に配列先頭から代入

  For i = LBound(arr1) To UBound(arr1) ' 1次元配列最大要素までループ処理
    arr1(i) = Columns(arr1(i)).Column ' 列名を列番号に変換
  Next i

' ----------

  ' 変数宣言
  Dim columnheadings1() As Variant ' 並べ替え前の見出し格納用配列変数宣言
  columnheadings1 = ws1.Range(ws1.Cells(1, 2), ws1.Cells(1, 6)).Value ' 検索元シートの見出し 1行目 2列目から最終列までを Range で範囲指定、配列として動的配列にセット

  ' 変数宣言
  Dim columnheadings2() As Variant ' 並べ替え後の見出し格納用配列変数宣言
  columnheadings2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(1, 6)).Value ' 検索元シートの見出し 1行目 2列目から最終列までを Range で範囲指定、配列として動的配列にセット

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

  ' For 文で配列 arr1 の各要素番号に代入した値を配列 columnheadings1 の列番号として、配列 columnheadings2 の 1行目の i 列目に項目名を代入
  For i = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素までループ処理
    columnheadings2(1, i) = columnheadings1(1, arr1(i - 1) - 1) ' 配列 columnheadings1 の 1行目 arr1(i - 1) - 1 番目の値にある列番号の項目名を、配列 columnheadings2 の 1行目の i 列目にセット
    ' arr1(i - 1) に - 1 をしているのは、シート 1列目（都道府県コード）を配列に格納していないため
  Next i
'  columnheadings2(1, 1) = columnheadings1(1, arr1(0) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 2) = columnheadings1(1, arr1(1) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 3) = columnheadings1(1, arr1(2) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 4) = columnheadings1(1, arr1(3) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 5) = columnheadings1(1, arr1(4) - 1) ' for 文を使わない場合の書き方

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

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

' ----------

  ' 変数宣言
  Dim myDic As Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
  Set myDic = New Dictionary ' Dictionary オブジェクト（参照設定 - Microsoft Scripting Runtime 設定が必要）
  Dim key1 As String ' Dictionary 用 Key 変数
  Dim row1 As Variant ' Dictionary 用 Item 変数（Key がある配列の行番号

  ' 検索先シートの Key と Item を Dictionary に登録
  For i = LBound(data1, 1) To UBound(data1, 1) ' 配列に格納した検索先シートの 1次元最大要素までループ処理
    key1 = data1(i, 1) ' 検索先シート i 行目の 1列目（都道府県コード）を Dictionary 用 Key 変数にセット
    row1 = i ' Key がある配列の行番号格納

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

' ----------

  ' 変数宣言
  Dim key2 As String ' Dictionary 用 Key 変数
  Dim row2 As Long ' Dictionary 用 Item 変数（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 ではない場合
      row2 = myDic(key2) ' 辞書（myDic）から Key（検索元シート i 行目の 1列目（都道府県コード）） と一致した Item を変数に格納

      For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
        data3(i, k) = data1(row2, arr1(k - 1)) ' 配列 data1 の row2 行 arr1(k - 1) 列目（配列 arr1 の要素番号 k - 1 にある列番号）を、配列 data3 の i 行 k 列目に格納
      Next k
'      data3(i, 1) = data1(row2, arr1(0)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(0) 列目（配列 arr1 の要素番号 0 に格納された値）
'      data3(i, 2) = data1(row2, arr1(1)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(1) 列目（配列 arr1 の要素番号 1 に格納された値）
'      data3(i, 3) = data1(row2, arr1(2)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(2) 列目（配列 arr1 の要素番号 2 に格納された値）
'      data3(i, 4) = data1(row2, arr1(3)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(3) 列目（配列 arr1 の要素番号 3 に格納された値）
'      data3(i, 5) = data1(row2, arr1(4)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(4) 列目（配列 arr1 の要素番号 4 に格納された値）
    Else ' myDic(key2) が Empty の場合
      For k = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素（Item）までループ処理
        data3(i, k) = "*****" ' Item がない場合 ***** 文字を配列に代入
      Next k
'      data3(i, 1) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 2) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 3) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 4) = "*****" ' for 文を使わない場合の書き方
'      data3(i, 5) = "*****" ' for 文を使わない場合の書き方
    End If
  Next i

' ----------

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

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

' ----------

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

End Sub

Excel VBA - 連想配列（Dictionary オブジェクト）を使った大量データ高速抽出・集計処理メモ → 連想配列（Dictionary オブジェクト）大量データ高速抽出処理 VBA サンプルコード 3（条件エラー改善版、大量データ抽出処理〇）

目次へ戻る↑

各シートのセル範囲を指定してセル値をまとめて 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, 1), ws2.Cells(maxrow2, 1)).Value ' 検索元シート（Key）最終行までを Range で範囲指定、配列として動的配列にセット
  data3 = ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)).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, 1), ws2.Cells(maxrow2, 1)))
'  data3 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(2, 2), ws2.Cells(maxrow2, 6)))

47～49行目のセル範囲の取得に使う Range プロパティの範囲指定で、開始セルの Cells プロパティを 1行目から 2行目に変更しています。

見出し部分のみの列入れ替えは別のコードで処理できるので、開始セルの行を 2行目からに戻しています。

Excel VBA - 連想配列（Dictionary オブジェクト）を使った大量データ高速抽出・集計処理メモ → ワークシートでセル範囲を指定してセル値をまとめて 2次元配列に格納

目次へ戻る↑

2次元配列を使って列見出し入れ替え転記

  ' 変数宣言
  Dim columnheadings1() As Variant ' 並べ替え前の見出し格納用配列変数宣言
  columnheadings1 = ws1.Range(ws1.Cells(1, 2), ws1.Cells(1, 6)).Value ' 検索元シートの見出し 1行目 2列目から最終列までを Range で範囲指定、配列として動的配列にセット

  ' 変数宣言
  Dim columnheadings2() As Variant ' 並べ替え後の見出し格納用配列変数宣言
  columnheadings2 = ws2.Range(ws2.Cells(1, 2), ws2.Cells(1, 6)).Value ' 検索元シートの見出し 1行目 2列目から最終列までを Range で範囲指定、配列として動的配列にセット

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

  ' For 文で配列 arr1 の各要素番号に代入した値を配列 columnheadings1 の列番号として、配列 columnheadings2 の 1行目の i 列目に項目名を代入
  For i = LBound(data3, 2) To UBound(data3, 2) ' 2次元最大要素までループ処理
    columnheadings2(1, i) = columnheadings1(1, arr1(i - 1) - 1) ' 配列 columnheadings1 の 1行目 arr1(i - 1) - 1 番目の値にある列番号の項目名を、配列 columnheadings2 の 1行目の i 列目にセット
    ' arr1(i - 1) に - 1 をしているのは、シート 1列目（都道府県コード）を配列に格納していないため
  Next i
'  columnheadings2(1, 1) = columnheadings1(1, arr1(0) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 2) = columnheadings1(1, arr1(1) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 3) = columnheadings1(1, arr1(2) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 4) = columnheadings1(1, arr1(3) - 1) ' for 文を使わない場合の書き方
'  columnheadings2(1, 5) = columnheadings1(1, arr1(4) - 1) ' for 文を使わない場合の書き方

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

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

設定した列順に従って列の見出し名のみを入れ替えて、ついでにシートへ転記します。

86行目と 90 行目に見出し名格納用の動的配列を宣言します。

87行目と 91 行目で Range プロパティと Cells プロパティを使って各シートの見出しがあるセル範囲を指定します。セル範囲が見出しだけで限定的のため、開始セルと終点セルともに行番号は 1 となっています。

2次元配列 columnheadings1 には列入れ替え前の見出し名を格納、2次元配列 columnheadings2 は列入れ替え後の見出し名格納先を配列として確保します。

106行目で For 文・カウンタ変数・LBound・UBound 関数で、データ格納先 2次元配列 data3 の 2次元（列相当）の最小～最大要素までループします。

107行目の For 文内でカウンタ変数 k を使って、2次元配列 columnheadings1 の 2次元の要素番号に列番号を格納した 1次元配列 arr1 をセットします。配列 arr1 の要素番号にはカウンタ変数 i を使って、順番に配列に格納された列番号を取り出すことで、二次元配列 columnheadings1 に格納されている見出し名を取得できます。取得した見出し名を 2次元配列 columnheadings2 に順番に格納しています。

配列 arr1 の要素番号に使用したカウンタ変数 i に - 1「arr1(i - 1)」をして、さらに配列 arr1 に対して - 1「arr1(i - 1) - 1」してる理由については以下の通りです。

まずカウンタ変数 i が最小値 1 からスタートした場合、arr1(1 - 1) となって arr1(0) にすることで、配列 arr1 の最小要素番号の 0 番から順番に要素（列番号）を取り出せるようにします。

1次元配列の開始要素番号は原則 0 番からなので、カウンタ変数 i の初期値が 1 の場合は - 1（1次元配列変数(カウンタ変数開始値1 - 1)）とすることで 1次元配列変数(0) となるように調整しています。

次に配列 arr1 の要素番号 0 番に格納されているのは列番号 6（= F 列）なので、カウンタ変数 i が 1 の場合、columnheadings1(1, arr1(i - 1)) は columnheadings1(1, 6) になります。ただし、これでは 87行目にセル範囲から代入した 2次元配列 columnheadings1 の 2次元の最大要素数を超えてしまい「インデックスが有効範囲にありません」というエラーメッセージが表示されてしまいます。

2次元配列 columnheadings1 にはセル B1 ～ F1 の各セルにある見出し名を 2次元の開始要素番号 1 から順番に格納しているので、F 列の見出し名を取得するには columnheadings1(1, 5) となっている必要があります。そこで arr1(i - 1) - 1 とすることで目的の値になるように調整しています。

117行目の Range オブジェクトでデータ転記先の開始セルを見出しがあるセル B1 にして、2次元配列 columnheadings2 に格納された見出し名を転記しています。

目次へ戻る↑

連想配列（Dictionary オブジェクト）から抽出したアイテムをシートへ転記（開始セル変更）

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

181行目の Range オブジェクトでデータ転記先の開始セルをセル B2 に変更しています。

2次元配列 data3 には見出し名は含まれていないので、検索キーに対応したアイテムの開始セルであるセル B2 を指定しています。

Excel VBA - 連想配列（Dictionary オブジェクト）を使った大量データ高速抽出・集計処理メモ → 連想配列（Dictionary オブジェクト）データ抽出処理 VBA サンプルコード 1（条件によってエラーあり、大量データ抽出処理×） - 連想配列（Dictionary オブジェクト）から検索キーを使ってアイテム取得

目次へ戻る↑

配列を使った列入れ替え処理 VBA サンプルコード 3

サンプルコード 1 とサンプルコード 2 はいずれも連想配列（Dictionary オブジェクト）を使っており重複データがあると除外してしまうため、単純なシート列入れ替え処理をしていませんでした。

以下、サンプルコード 1 をもとに、シート内すべてのセルを対象に連想配列（Dictionary オブジェクト）を使わず配列のみで、シート内の指定した列に対して入れ替え処理を行う VBA サンプルコード 3 です。

連想配列（Dictionary オブジェクト）を使ってない分、コードが短くなっています。次のセクションでは変更したコード箇所を説明します。

配列を使った列入れ替え処理 VBA サンプルコード 3（クリックで開閉）

Option Explicit

Sub MatchDictPrefCodeSortColumns3()
  ' シート「都道府県県庁所在地地方区分ランダム並べ替え」から都道府県、Prefectures、県庁所在地、Capital、地方区分を取得して列を入れ替え

  ' 実行速度計測開始
  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("都道府県県庁所在地地方区分抽出列入れ替え3") ' 検索元シート（Key）をオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 一致したデータ出力先テスト用シート

' ----------

  ' 最終行取得用変数
  Dim maxrow1 As Long, maxrow2 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, data2() As Variant

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

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

' ----------

  ' Item データ格納用 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 ' 配列に Empty を代入して初期化
    Next k
'    data2(i, 1) = Empty ' for 文を使わない場合の書き方
'    data2(i, 2) = Empty ' for 文を使わない場合の書き方
'    data2(i, 3) = Empty ' for 文を使わない場合の書き方
'    data2(i, 4) = Empty ' for 文を使わない場合の書き方
'    data2(i, 5) = Empty ' for 文を使わない場合の書き方
'    data2(i, 6) = Empty ' for 文を使わない場合の書き方
  Next i

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

' ----------

  ' 変数宣言
  Dim arr1() As Variant ' 1次元配列格納用動的配列宣言
  arr1 = Array("A", "F", "C", "E", "B", "D") ' Array 関数の要素に配列 data1（検索先シート）の並べ替え対象列名を、並べ替えたい順番に配列先頭から代入

  For i = LBound(arr1) To UBound(arr1) ' 1次元配列最大要素までループ処理
    arr1(i) = Columns(arr1(i)).Column ' 列名を列番号に変換
  Next i

' ----------

  ' 配列内の列データ並べ替え
  For i = LBound(data1, 1) To UBound(data1, 1) ' 1次元最大要素までループ処理
    For k = LBound(data1, 2) To UBound(data1, 2) ' 2次元最大要素までループ処理
      data2(i, k) = data1(i, arr1(k - 1)) ' 配列 data1 の i 行 arr1(k - 1) 列目（配列 arr1 の要素番号 k - 1 にある列番号）を、配列 data2 の i 行 k 列目に格納
    Next k
'    data2(i, 1) = data1(i, arr1(0)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(0) 列目（配列 arr1 の要素番号 0 に格納された値）
'    data2(i, 2) = data1(i, arr1(1)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(1) 列目（配列 arr1 の要素番号 1 に格納された値）
'    data2(i, 3) = data1(i, arr1(2)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(2) 列目（配列 arr1 の要素番号 2 に格納された値）
'    data2(i, 4) = data1(i, arr1(3)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(3) 列目（配列 arr1 の要素番号 3 に格納された値）
'    data2(i, 5) = data1(i, arr1(4)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(4) 列目（配列 arr1 の要素番号 4 に格納された値）
'    data2(i, 6) = data1(i, arr1(5)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(5) 列目（配列 arr1 の要素番号 5 に格納された値）
  Next i

' ----------

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

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

' ----------

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

End Sub

目次へ戻る↑

各シートのセル範囲を指定してセル値をまとめて 2次元配列に格納（全セル対象）

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

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

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

並べ替え対象のシートと転記先シートを 2次元配列に格納します。

45行目のセル範囲の取得に使う Range プロパティの範囲指定で、開始セルの Cells プロパティを 1行 1列目から最終行・最終列にして、見出しを含むシート内すべてのセルを指定しています。

並べ替えるだけなので 46行目の転記先シートの範囲も並べ替え対象シートと同じ範囲となります。

目次へ戻る↑

配列を使って入れ替え対象列名の設定と列順番セット＆列番号変換（すべての列）

  ' 変数宣言
  Dim arr1() As Variant ' 1次元配列格納用動的配列宣言
  arr1 = Array("A", "F", "C", "E", "B", "D") ' Array 関数の要素に配列 data1（検索先シート）の並べ替え対象列名を、並べ替えたい順番に配列先頭から代入

  For i = LBound(arr1) To UBound(arr1) ' 1次元配列最大要素までループ処理
    arr1(i) = Columns(arr1(i)).Column ' 列名を列番号に変換
  Next i

サンプルコード 1 と同じ、入れ替え対象列名の設定と列順番セット＆列番号変換ですが、74行目の Array 関数に連想配列（Dictionary オブジェクト）のため除外していた A 列を追加しています。

目次へ戻る↑

配列に格納した指定した列順番に従って 2次元配列でデータ入れ替え

  ' 配列内の列データ並べ替え
  For i = LBound(data1, 1) To UBound(data1, 1) ' 1次元最大要素までループ処理
    For k = LBound(data1, 2) To UBound(data1, 2) ' 2次元最大要素までループ処理
      data2(i, k) = data1(i, arr1(k - 1)) ' 配列 data1 の i 行 arr1(k - 1) 列目（配列 arr1 の要素番号 k - 1 にある列番号）を、配列 data2 の i 行 k 列目に格納
    Next k
'    data2(i, 1) = data1(i, arr1(0)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(0) 列目（配列 arr1 の要素番号 0 に格納された値）
'    data2(i, 2) = data1(i, arr1(1)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(1) 列目（配列 arr1 の要素番号 1 に格納された値）
'    data2(i, 3) = data1(i, arr1(2)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(2) 列目（配列 arr1 の要素番号 2 に格納された値）
'    data2(i, 4) = data1(i, arr1(3)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(3) 列目（配列 arr1 の要素番号 3 に格納された値）
'    data2(i, 5) = data1(i, arr1(4)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(4) 列目（配列 arr1 の要素番号 4 に格納された値）
'    data2(i, 6) = data1(i, arr1(5)) ' for 文を使わない場合の書き方 - 「都道府県県庁所在地地方区分ランダム並べ替え」シートの arr1(5) 列目（配列 arr1 の要素番号 5 に格納された値）
  Next i

' ----------

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

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

サンプルコード 1 から連想配列（Dictionary オブジェクト）に関する処理を除き、配列を使って列データを入れ替える処理です。

83～84行目で並べ替え対象のデータを格納した 2次元配列 data1 を For 文で、1次元・2次元の最小～最大のループ処理を行います。

85行目では For 文内でカウンタ変数 i と k を使って 2次元配列 data1 にあるデータを 2次元配列 data2 に格納して列データを並べ替えています。

サンプルコード 1 では 2次元配列 data1 の 1次元の要素に連想配列（Dictionary オブジェクト）のキーを格納した変数 row2（117行目）を指定していましたが、連想配列は使わないので For 文内で参照中行番号のカウンタ変数 i に変更しています。

98行目の Range オブジェクトでデータ転記先の開始セルをセル A1 に変更しています。

目次へ戻る↑