2020/11/09

複数行1データの並び替え




1.背景

データの項目が多い場合、ワークシートの列を多く使う横長の表になってしまいます。いくら横スクロールバーが有るからと言っても1行が横に長い表は見難いと思います。
その解決策の1つである「複数行で1つのデータ」は、紙や画面に表示した時の見易さから世の中では多用されています。また以前流行したカード型データベースの影響もあるのかもしれません。

しかし「複数行1データ」をExcelで扱うのは非常にやっかいです。他のサイトを見ても「止めなさい」という意見がほとんどです。しかし既存のデータを活用することも重要ですので、今回は「複数行1データ」を各項目で並び替える手法について紹介します。

2.システム概要

図2-1のように複数行で1つのデータがあるとします。1~2行目がタイトル行(黄色く塗ったセル)になっており、そのタイトルのどこかのセル(図2-1では「ふりがな」セル)をダブルクリックすると、ダイアログボックスが起動します。
ワークシート上の複数行1データとダイアログ
図2-1

ダイアログボックスで、「昇順」か「降順」を選択し「OKボタン」をクリックすることで、図2-2のように並び替えが実行されます。
データの並び替え後の状態
図2-2

複数行を同時に並び替えする方法は、色々考えられます。一般的なものは「データの横に列を追加し、並び替える文字と連番を記入」するものです。
他には、複数行1データを1行1データにしてから並び替え後、再び複数行に戻す方法も考えられます。
またデータを配列に入れ、配列内で並び替えをする方法が考えられます。しかし私もトライしたのですが、あまりにも大変なので途中で断念しました。
またまた、検索データのある行を残して他の行を非表示にした後並べ替えると「表示行のみが並び替わる」のですが、残された非表示の行の移動方法がうまく思いつかず、こちらも断念しました。

ということで今回は、「並べ替え列追加法」と、配列を値とするCollectionオブジェクトを使用した「Collection法」の2つを紹介します。
どちらの方法にしても、外観・操作法は図2-1、図2-2で同じです。

3.プログラムの流れ

3-1.並べ替え列追加法

図3-1はサンプルファイルの「2行1データ」です。G列・H列はプログラムから検索のためのデータを書きこんだ途中段階で、実際には画面更新を停止させているので見えない画面です。黄色の部分がタイトル行になります。
補助列を追加して並び替え
図3-1

プログラムの流れは図3-2の通りです。まず、タイトルセル部にはダブルクリックのイベントプロシージャが設定してあり、タイトルのどれか(図3-1では「ふりがな」)をダブルクリック①すると、マクロが作動し、データ範囲の右側(ここではG列・H列)に2列分の列追加②をします。
次に各データごとに、「並べ替えワード③」を追加した列にコピーします。また「連番④」も記入します。
並べ替え列の準備が完了したら、「並べ替えワード③」をKey1、「連番④」をKey2にして並べ替えを実行します。
最後に、追加したG列・H列を削除します。
列追加法のプログラムの流れ
図3-2

3-2.Collection法

データをまとめて管理するやり方として、Excelには「配列」「Collection」「Dictionary」が用意されています。
今回データの集まりを扱うに当たり、どれを使うのが効果的か、図3-3で考えてみます。
(Collection、Dictionary については「CSVファイルでデータを読み書きする月間予定表」も参照下さい)

データのかたまりを順番を付ける際のメリット・デメリット
手法メリットデメリット
配列配列へのデータ取り込みは、
範囲指定のみで簡単に出来る
並び替えるためには、
一度別の配列に仮置きする等が必要
Collection1データずつ収めた配列をCollectionの値に出来る
どの位置に挿入するか指定可能
値の一括削除のコマンドが無い
Dictionary1データずつ収めた配列をDictionaryの値に出来る
値の一括削除が出来る
(Key設定必須の為)Keyに並び順を設定するとして、
入替え時には他の値のKey値も変更要
図3-3

以上の比較表から「Collection」を使い「1つのデータを配列にした上でCollectionの値」とし、「順番を付けながらCollectionに登録」することにしました。
尚、CollectionにもKeyを登録することは可能であり、並び替え用のワードをKey登録すると便利そうでしたが、データ側で並び替えワードが重複している可能性がある(例えば、出身地が同じとか、性別が同じとか)ため、今回はKeyを使用しませんでした。

Collection法で並び替えをするイメージを図3-4に示しました。
データ単位で配列にし、インデックスを付けながらCollectionの値にする
図3-4

プログラムとしての流れも図3-5に示しました。タイトルセル部にはダブルクリックのイベントプロシージャが設定してあり、タイトルのどれか(図3-4では「ふりがな」)をダブルクリック①すると、マクロが作動します。(ここまでは、並べ替え列追加法と同じ)
シート上のデータを1つずつ配列にし、それをCollectionの値として登録していきます。Collection登録時にはインデックスを指定しない場合には最終のインデックス番号が付与されますが、既存のCollectionのインデックスの前後を指定できる機能もあります。
そこで登録前に既存のCollectionのデータの「並び替えワード」と比較を行い、昇順に並ぶ位置にインデックスを指定しながら登録を進めていきます。(この場合、割り込まれた他のCollectionのインデックスは、自動的に振られ直されます)

全データがCollection化されると、データは「並び替えワード」の昇順でインデックス番号が並んでいることになります。
そこで、タイトルセルのクリック時①に同時に指定した並び順が「昇順」の場合には、インデックスの順番通りにシート上に配列を貼り付けていきます。尚「降順」を選んでいた場合には、インデックスを逆から貼っていきます。
Collection法のプログラムの流れ
図3-5

4.昇順・降順ダイアログ

並び替えには「昇順」と「降順」があります。
データを並べているサイトを見てみると、図4-1のような感じに「昇順・降順ボタン」を設けているところが多いようです。 昇順・降順ダイアログの外観作成
図4-1

このような仕様にすることはExcelでも可能ですが、かなり面倒なので、今回は「ダブルクリックで項目を感知」し、「ダイアログで昇順・降順を選択」する仕様にしました。
なお、「並び替え列追加法」「Collection法」の両方で同じダイアログ(UserForm1)を使います。

4-1.フォームの作成

フォーム画面設計は、図4-2のように「オプションボタン」で昇順・降順を選択し、並べ替え実行用のOKボタンとキャンセルボタンを配置しています。ボタン表面の文字は、ダイアログ起動時にプログラムで書くようにしています。
昇順・降順ダイアログの外観作成
図4-2

4-2.フォームモジュール

今回のシステムは、ワークシート上のデータを並び替えするものです。並び替えには「昇順」「降順」がありますが、ユーザーがダイアログ上でどちらを選択したかの情報が、ワークシート側での並び替え実施の時に必要になります。
フォーム側とワークシート側で情報をやり取りする方法はいくつか考えられます。
 1.共通のパブリック変数を使う
 2.セルを情報の受け渡し場所にする
 3.フォームのLabelやTextBoxを情報の受け渡し場所にする
 4.フォーム内のSubプロシージャを引数付きで呼び出し、その引数で情報を受け渡す
 5.フォーム内の関数プロシージャを呼び出し、その戻り値で情報を受け渡す
今回は「5」の方法を使用します。

4-2-1.起動準備とフォーム起動

ユーザーが「昇順」「降順」のどちらを選択したかは変数SelectOption の値で保存されます。そしてワークシート側から呼び出される関数プロシージャ「UF1_Start」は、その変数SelectOptionの値を戻り値としてワークシート側に戻します。
ですので変数SelectOption はモジュールの中のみで生きていれば良い値ですので、フォームモジュールレベルの変数として、図4-3の2行目で宣言します。

なお変数SelectOption の値は、「1=昇順を選択」「2=降順を選択」「0=キャンセル」を表すことにします。
(値を1,2にしたのは、Sortメソッドのorderに設定する値が「1=昇順」「2=降順」であることから決めました。)
  1. '========== ⇩(1) フォームレベル変数設定 ====================
  2. Dim SelectOption As Long
  3. '========== ⇩(2) 起動時のフォーム初期化 ====================
  4. Private Sub UserForm_Initialize()
  5.  Me.OptionButton1.Value = True
  6.  SelectOption = 1
  7.  Me.CommandButton1.Caption = "Sort実行"
  8.  Me.CommandButton2.Caption = "Cancel"
  9. End Sub
  10. '========== ⇩(3) シート側から呼ばれるフォーム起動プロシージャ ============
  11. Function UF1_Start()
  12.  Me.Show
  13.  UF1_Start = SelectOption
  14. End Function
図4-3

フォームが最初に起動する際には5~10行目のInitializeイベントが発生します。
6行目ではOptionButtn1(昇順)をTrueにします(OptionButtn1を選択していることになる)。
それと同時に、「どちらを選択しているかを表す変数SelectOption」に「1(昇順)」を代入します。

6行目はOptionButton1のValue値を変更していますので、それを実行した時点でOptionButton1のClickイベントが発生し、図4-4の18~20行目が実行されます。ですので本当は7行目が無くても大丈夫なのですが、「OptionButtonを変更したら変数SelectOptionの値を変更する」ことを強調するため、6行目と7行目はセットにしました。

なお、フォームはHideで閉じています(図4-5の28行目他)ので「並び替え順序は保存」され、次にダイアログを起動した時には1つ前に選択した「並び替え順序」でまず表示されます。
もし「最初に表示されるのは、必ず昇順」にしたい場合は、「Activeイベントプロシージャ(新規作成)に、6~7行目を移動」させて下さい。

8~9行目では、CommandButtonの表面に文字を記入してます。

ワークシート側から呼び出される関数プロシージャ「UF1_Start」が13~16行目で、呼び出されるとすぐに自分自身(UserForm1)を表示します(14行目)。
フォームモジュールレベル変数SelectOptionの値は起動時「1(7行目で設定)」ですが、ダイアログ上でユーザーが操作をし変更した場合は変数SelectOptionに反映されます。その反映された変数SelectOptionを、15行目で関数の戻り値に設定し、ワークシート側へ「ユーザーが昇順・降順のどれを選択したか」の情報を渡します。


今回は「変数SelectOption」を使って「昇順」「降順」のどちらの状態になっているかを記憶していますが、このような変数を使わずに「ワークシート側に戻す段階でOptionButton1のValue値を確認し、Trueなら1をFalseなら2を戻す」方法も考えられます。
但し、キャンセルボタンをクリックした時にも「どちらかを選んだ」事になってしまいますので、キャンセルボタンやダイアログ右上×印のイベントプロシージャには、ダイアログを閉じる前に「2つのOptionButtonのValue値をFalse」にし、戻す値も「どちらもFalseだったらゼロを戻す」ような処理が必要になります。

4-2-2.オプションボタンでの選択

「昇順」「降順」のOptionButtonをクリックした時に発生するイベントプロシージャが図4-4です。
選んだ側のボタンのValue値がTrue(先頭の白丸が黒丸に変更)になった際に発生するイベントですので、変数SelectOptionにも同時に値を代入します。(19行目、24行目)
  1. '========== ⇩(4) 「昇順」ボタンをクリックした時 ====================
  2. Private Sub OptionButton1_Click()
  3.  SelectOption = 1
  4. End Sub
  5. '========== ⇩(5) 「降順」ボタンをクリックした時 ====================
  6. Private Sub OptionButton2_Click()
  7.  SelectOption = 2
  8. End Sub
図4-4

4-2-3.OKボタン・キャンセルボタンのクリック

「OK」ボタン「キャンセル」ボタン、および「ダイアログ右上の×印」をクリックした時のイベントプロシージャが図4-5です。
  1. '========== ⇩(6) 「OK」ボタンをクリックした時 ====================
  2. Private Sub CommandButton1_Click()
  3.  Me.Hide
  4. End Sub
  5. '========== ⇩(7) 「キャンセル」ボタンをクリックした時 ====================
  6. Private Sub CommandButton2_Click()
  7.  SelectOption = 0
  8.  Me.Hide
  9. End Sub
  10. '========== ⇩(8) ダイアログ右上×印をクリックした時 ====================
  11. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  12.  SelectOption = 0
  13. End Sub
図4-5

まず「OK」ボタンの場合は、28行目でダイアログをそのまま閉じる(Hide=隠す)ことで図4-3の15行目に制御が移り、呼出し元のワークシート側へ「ユーザーが選択した昇順・降順の数値」が渡ることになります。

「キャンセル」ボタンの場合は、33行目で変数SelectOptionに「キャンセルの意味である値ゼロ」を代入します。
そしてダイアログを閉じ(Hide)て図4-3の15行目に制御が移り、呼出し元のワークシート側へ「ユーザーがキャンセルを選択した」値が渡ることになります。

ダイアログ右上×印をクリックした時には「QueryClose」イベントが発生しますので、39行目で変数SelectOptionに「キャンセルの意味である値ゼロ」を代入します。
QueryCloseイベントの第1引数にCancelがありますが、これを使って「Cancel = True」としていませんのでダイアログは閉じられます。ですので、34行目のような「Me.Hide」は QueryClose には必要ありません。


ここで使っているHide(隠す)では無く、本当にフォームを閉じる(Unload Me)を実行してしまうと、ユーザーが選択した値が戻せなくなるだけでなく、図4-6のようなエラーが発生してしまいます。
これは、ワークシート側からフォームモジュール上の「関数プロシージャ」を呼び出しているためです。
フォームをUnloadした時のオートメーションエラー
図4-6

もしメモリー消費を抑える等の理由でUnloadを使うのであれば、『ワークシートモジュール側・標準モジュール側からは「UserForm1.Show」でフォームを呼び出し、共有の変数など(含:シート上のセル)で値を受け渡す』ような手法にすることで、正常にフォームを閉じる(Unload)ことが出来ます。


5.並べ替え列追加法(ワークシートモジュール)

図3-1、図3-2の「並べ替え列追加」による並べ替えについて説明します。尚、サンプルファイルでは「Sheet1」になります。

5-1.シートレベル定数の宣言

タイトル部のセル範囲を確定しておく必要があるので、定数宣言を先頭の宣言部で行っています。
  1. '========== ⇩(9) シートレベル定数の宣言 ====================
  2. Const titleStartRow = 1
  3. Const titleEndRow = 2
  4. Const titleStartCol = 1
  5. Const titleEndCol = 6
図5-1

タイトル部の位置と定数の関係は図5-2の通りです。この定数値は範囲設定に使用するだけでなく、ダブルクリックしたセル位置と並び替えワードの位置を結び付ける時にも使用するものなので、数値を得られるR1C1法で位置を表しています。
タイトル行と定数の関係
図5-2

5-2.ダブルクリックによるイベントプロシージャ

ワークシート上のどこかのセルをダブルクリックすると、図5-3のBeforeDoubleClickイベントが発生します。
  1. '========== ⇩(10) タイトル行ダブルクリック時イベント ====================
  2. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  3.  If Not Intersect(Target, Range(Cells(titleStartRow, titleStartCol), Cells(titleEndRow, titleEndCol))) Is Nothing Then
  4.   Dim ansUF1 As Long           'ダイアログの戻り値(昇順・降順・キャンセル)
  5.   Dim DataRange As Range        '←データ範囲
  6.   Dim DataWidth As Long         'データ範囲の幅
  7.   Dim DataStep As Long          '1データの行数
  8.   Dim keyRow As Long           '選択項目のタイトル部内の位置(縦方向)
  9.   Dim keyCol As Long           '選択項目のタイトル部内の位置(横方向)
  10.   Cancel = True               'ダブルクリックによるセル編集を中止
  11.   ansUF1 = UserForm1.UF1_Start      'ダイアログ表示
  12.   If ansUF1 = 0 Then Exit Sub       'キャンセルの時は抜け出す
  13.   Set DataRange = DataArea        '←データ範囲をRange型で取得(右端列加工前に取得)
  14.   If DataRange Is Nothing Then      'データが存在しない場合は抜け出す
  15.    MsgBox "データがありません"
  16.    Exit Sub
  17.   End If
  18.   DataWidth = titleEndCol - titleStartCol + 1             'データの幅
  19.   DataStep = titleEndRow - titleStartRow + 1             '1データの行数
  20.   keyRow = Target.Row - titleStartRow + 1               '選択項目の縦方向位置
  21.   keyCol = Target.Column - titleStartCol + 1             '選択項目の横方向位置
  22.   Set DataRange = DataRange.Resize(Int((DataRange.Rows.Count - 1) / DataStep + 1) * DataStep)
  23.   Application.ScreenUpdating = False
  24.    Call AddCol2(DataRange)                           'データ範囲の右側に2列追加
  25.    Call WordNumAdd(DataRange, keyRow, keyCol, DataStep)       '追加した2列に、並び替えワードと連番を記入
  26.    DataRange.Resize(, DataWidth + 2).Sort _
  27.       Key1:=DataRange(1).Offset(, DataWidth), order1:=ansUF1, _
  28.       Key2:=DataRange(1).Offset(, DataWidth + 1), order2:=1       '追加2列で並び替え実施
  29.    Call DelCol2(DataRange)                           '追加した2列を列削除
  30.   Application.ScreenUpdating = True
  31.   Set DataRange = Nothing
  32.  End If
  33. End Sub
図5-3

48行目は「タイトル部分をダブルクリックしたか」を判断する部分です。
「Intersect(セル範囲A , セル範囲B) 」は、セル範囲Aとセル範囲Bの重なっているセル範囲を返す関数で、「Not Intersect(セル範囲A , セル範囲B) Is Nothing」は「セル範囲Aとセル範囲Bが重なっている部分が存在する場合にTrue」となります。
48行目でのセル範囲Aはダブルクリックしたセル、セル範囲Bはタイトル部ですので、If文は「クリックしたセルがタイトル部だったら」という意味になります。

55行目では、第二引数の「Cancel」にTrueを代入することで「ダブルクリックによるセル編集を中止」にします。
「セル編集を中止」にしなくても(=55行目が無くても)並び替えは実行されますが、並び替え完了した後でも「タイトル部のセルを編集している状態」になるのは、ユーザーに誤解を与える事になると思われるので「Cancel = True」を実行しています。
なお、本当にタイトル部を編集したい場合は、「F2キーを押して編集モード」にして下さい。

57行目はUserForm1の中の「UF1_Start」関数プロシージャを呼び出し、ユーザーが選択した並び順又はキャンセルを値として変数ansUF1で受け取ります。


標準モジュールに書かれたプロシージャ以外は、呼び出す時に「そのプロシージャの場所を示すオブジェクト名を付ける」必要があります。表にすると図5-4の様になります。
各モジュールからのプロシージャ呼び出し方法(プロシージャ名が異なる時)
図5-4

ブック以外は複数のモジュールを作ることが出来ますので、例えばフォームモジュールから異なるフォームモジュールのプロシージャを呼び出す時でもオブジェクト名を付ける必要があります。
但し、自モジュール内に呼び出すプロシージャが存在する場合には、オブジェクトを指定する必要はありません。

また標準モジュール内のプロシージャは、どこからでもそのまま呼び出せます。しかし同じ名前のプロシージャが、呼び出すモジュール内と標準モジュール内の両方に存在するような場合には、自モジュールにあるプロシージャを呼び出します。もし標準モジュールの方のプロシージャを呼び出したいのであれば、オブジェクトを付けて呼び出します(図5-5)。

各モジュールからのプロシージャ呼び出し方法(プロシージャ名が同名の時)
図5-5


57行目でダイアログからの戻り値を受取った変数ansUF1が、ゼロ(=キャンセル)だった場合にはイベントプロシージャを抜け出し、並べ替え処理を中止します。(58行目)

60行目ではDataArea関数(図5-17)を呼び出し、戻り値として「データ範囲」を取得し、変数DataRangeに代入します。
しかしデータ行が無かった場合には「Nothing」を戻すことになっているため、61行目で判断し62行目でコメントを出して並べ替えを終了(63行目)します。

66~69行目は、データ範囲の諸元(図5-6)を変数に代入しています。変数を使わずに右辺の式を72行目以降で使用しても良いのですが、式を分かり易くするために置き換えています。
データ範囲の諸元取得
図5-6
この中で66行目のDataWidthは「titleEndCol - titleStartCol + 1」としていますが、「DataRange.Columns.Count」としてもOKです。この「データ範囲の幅」が使える理由は、今回「DataArea関数」で得られるデータ範囲が「titleStartCol から titleEndCol の幅」になるように範囲調整しているからです。

70行目の「Set DataRange = ・・・」は、60行目で取得したデータ範囲(DataRange)の補正をしています。
データが各行とも埋まっていれば問題無いのですが、例えば図5-7のように1行だけデータが無かった場合には、中途半端なデータ範囲が取得されてしまいます。
データが1行欠落していた時に取得されるデータ範囲
図5-7

このままの状態で並び替えワードを記入してしまうと、図5-8のように「1つ不足した状態」になります。
データが1行欠落していた場合の並び替えワードの記入状態
図5-8

このまま並び替えを実行すると、図5-9のように「1行欠けたデータが複数行データの中に混じり込む」ことになり、気が付かないでいると「データ項目が上下入れ替わってしまう」ような現象が発生します。
データが1行欠落していた場合の並び替えの結果
図5-9

これを防ぐために70行目では、欠けている行も含めたデータ範囲に修正をします。
補正する総行数は、「総行数(DataRange.Rows.Count)を1データ行数(DataStep)で割り、その結果を切り上げしてから再度1データ行数(DataStep)を乗ずる」ことで求められます。これを実現するには、以下の2つの式が考えられます。
 (1) Int((DataRange.Rows.Count - 1) / DataStep + 1) * DataStep
 (2) Int( -1 * DataRange.Rows.Count / DataStep ) * -1 * DataStep
どちらを使ってもOKですが、70行目には(1)の式を載せています。
なお(2)の式は「Intは小さい方の整数にする」ことを利用し、一度マイナス値にしてIntで丸めた後、再度プラスにしています。
ちなみに「データが行落ちする事は絶対にない」のであれば、70行目は不要です。

73~80行目では「列追加→並び替えワード記入→並び替え→列削除」という実作業をしています。セル上のデータ変更がありますので、画面ちらつき防止と処理速度向上のために、72行目で画面更新停止をし82行目では再び復活させています。

73行目では「AddCol2」プロシージャを呼出し、データ範囲の右側に2列分の列追加をしています。追加列の位置特定時にデータ範囲の右端位置が必要なため、引数として「DataRange:データ範囲」を渡します。
74行目では「WordNumAdd」プロシージャを呼び出し、73行目で追加した列の1列目に「並び替えワード」を記入し2列目に「上からの連番」を記入します。
記入位置を定めるために、第一引数として「DataRange:データ範囲」を渡し、第2~3引数として「各データの中の並び替えワードの位置」、第4引数として「何行で1データか」を渡しています。

76~78行目では並び替えを実行します。
まず並び替えの範囲ですが、「DataRange.Resize(, DataWidth + 2)」と「73行目で追加した右端2列を加えた範囲」にしています。
なお「Resize(DataRange.rows.count, DataWidth + 2)」としっかり記述しなくても、「省略した時は元の幅」になります。

次に並び替えのキーですが、第一キーには追加列の「並び替えワード」列を指定し、第二キーに追加列の「連番」列を指定します。
その位置(Key1及びKey2の値)は「文字列の範囲名、または Rangeオブジェクト」で指定しますが、今回はRangeで指定しています。
図5-10のように「データ範囲の左上角のセル位置(データ範囲のインデックス1番)」を基準にOffsetでセル位置を移動させています。
なお、指定するキーの位置は「キー列であればどこでも良い」ようです。例えば図5-10でのKey1は「G3セル」を指示していますが、G1セルやG20セル(=並び替え範囲以外)でも正しく並び替えをしてくれます。
並べ替えのキーの位置
図5-10
また並べ替え順序を指定する引数「order」には、「昇順=1」「降順=2」のどちらかを指定します。
77行目のorder1には、57行目でダイアログから受け取った値(ansUF1)を指定しています。このorderに直接指定出来るように、ダイアログで昇順を選択したら1に、降順を選択したら2になるように戻り値を決めています。
なお78行目の「order2」の方は「必ず昇順でないと、1つのデータの中での順番が狂ってしまう」ために、1を設定しています。

並び替えが完了したら、73行目で追加した2列を列削除します。(80行目)
83行目では、役目を終えたDataRangeオブジェクトを解放します。

5-3.並べ替え列追加と削除

並び替えのための列追加が図5-11のAddCol2プロシージャで、図5-3の73行目から呼び出されます。
また追加した列を削除するのがDelCol2プロシージャで、図5-3の80行目から呼び出されます。
  1. '========== ⇩(11) 並べ替え列追加 ====================
  2. Private Sub AddCol2(DataRange As Range)
  3.  Me.Columns(DataRange.Column + DataRange.Columns.Count).Resize(, 2).Insert Shift:=xlShiftToRight
  4. End Sub
  5. '========== ⇩(12) 並べ替え列削除 ====================
  6. Private Sub DelCol2(DataRange As Range)
  7.  Me.Columns(DataRange.Column + DataRange.Columns.Count).Resize(, 2).Delete Shift:=xlShiftToLeft
  8. End Sub
図5-11

どちらのプロシージャも、引数にはデータ範囲であるDataRangeを受け取ります。
そのデータ範囲の右外側の2列は図5-12の①~⑤の手順でを取得します。そして89行目ではInsertメソッドで列追加し、94行目ではDeleteメソッドで列削除します。
列追加・削除の位置
図5-12

また列追加・削除後にセルを動かす方向(引数:Shift)ですが、89行目では「xlShiftToRight」、94行目では「xlShiftToLeft」としています。
これは図5-13の通り「右へシフト」「左へシフト」と言う意味ですが、指定している範囲が「列」ですので、引数Shiftが未指定でも「右へ」「左へ」シフトされます。しかも「xlShiftDown」等の間違った設定を仮にしても、ちゃんと「右へ」「左へ」シフトされます。
つまり「列指定で列追加・列削除の時は、Shift引数は無視される」ことになります。
今回は明示的にShift引数を付けています。

図5-13で、方向を表す値をまとめています。
例えばセル削除時に「xlShiftToLeft」を使うべきところで「xlToLeft」を使用しても、値は同じですので正常に動きます。しかし「削除時には削除用の値を使い、セル移動時にはセル移動用の値を使う」という正しい値の使い方が、バグを見つける第一歩になると思います。
列挙体名前内容
XlInsertShiftDirection
挿入後どうシフトするか
xlShiftDown-4121セルを挿入後、下に伸ばす
xlShiftToRight-4161セルを挿入後、右に伸ばす
XlDeleteShiftDirection
削除後どうシフトするか
xlShiftToLeft-4159削除後、セルは左にシフトする
xlShiftUp-4162削除後、セルは上にシフトする
xldirection
移動する方向
xldown-4121下へ
xlToLeft-4159左へ
xlToRight-4161右へ
xlup-4162上へ
図5-13

5-4.並べ替え列へデータの追加

データ範囲の右側に追加した列に、「並べ替えワード」と「連番」を記入するのが図5-14です。
引数として、データ範囲(DataRange)、各データの中の並び替えワードの縦方向位置(keyRow)、横方向位置(keyCol)、1データの行数(DataStep)の4つを受取ります。
  1. '========== ⇩(13) 並べ替えデータの追加 ====================
  2. Private Sub WordNumAdd(DataRange As Range, keyRow As Long, keyCol As Long, DataStep As Long)
  3.  Dim i As Long       'データ範囲中の先頭からの行位置
  4.  Dim DataNo As Long    'データ範囲中の何番目のデータかを表す変数
  5.  For i = 1 To DataRange.Rows.Count
  6.   DataNo = Int((i - 1) / DataStep) + 1
  7.   DataRange.Cells(i, 1).Offset(, DataRange.Columns.Count) = _
  8.           DataRange.Cells(keyRow + (DataNo - 1) * DataStep, keyCol)
  9.   DataRange.Cells(i, 1).Offset(, DataRange.Columns.Count + 1) = i
  10.  Next i
  11. End Sub
図5-14

まず101行目のFor~Nextで、データ範囲(DataRange)の先頭行から最終行までを回していきます。
102行目では、変数iで表された行のデータの「データ番号」を計算します。計算方法は図5-15のように、行位置を1データの行数(DataStep)で割った商を求めるやり方です。
データ番号の計算
図5-15

103~104行目は、追加した列の左側列に代入する部分です。
まず103行目の左辺は「データ範囲を基準としてCells(行,列)で求めたセル位置(図5-16のA列の各セル位置)」から、横にOffsetで移動させて「並び替えワードを代入するセル(図5-16のG列)」の位置を特定しています。

一方104行目の右辺は、並べ替えワードの位置を示しています。
1つのデータ範囲のRangeオブジェクトを仮に[1つのデータ範囲]とすると、その1つのデータ範囲(図5-16では A3:F4)の中での並べ替えワード(図5-16では「ひらがな」)の相対的位置は「Cells(KeyRow,KeyCol)」で表されます
この相対的位置を102行目で得たデータ番号(DataNo)を使って、絶対的位置を求めています。
この式により、並べ替えワードがデータ行数分だけ並んで記入できます。
並び替えワードの相対的・絶対的位置の計算
図5-16

105行目は「連番」の記入です。左辺は103行目の時の1つ隣(図5-16のH列)で、記入する値は「データ範囲の行番号」です。
この連番は1から始まらなくても徐々に大きくなれば良いので、例えばワークシートの行番号にしてもOKです。

5-5.データ範囲取得

5-5-1.通常のデータ範囲取得

図5-3の60行目から呼び出されるのが図5-17です。この関数プロシージャは、データ範囲を戻します。
  1. '========== ⇩(14) データ範囲取得1 ====================
  2. Private Function DataArea() As Range
  3.  Dim AllArea As Range         'CurrentRegionで取得される「タイトル+データの範囲」
  4.  Set AllArea = Cells(titleEndRow, titleStartCol).CurrentRegion
  5.  Set DataArea = Range(Cells(titleEndRow + 1, titleStartCol), Cells(AllArea(AllArea.Count).Row, titleEndCol))
  6.  If AllArea(AllArea.Count).Row = titleEndRow Then
  7.   Set DataArea = Nothing
  8.  End If
  9.  Set AllArea = Nothing
  10. End Function
図5-17

112行目は「アクティブセル領域」を取得し、変数AllAreaに代入しています。
アクティブセル領域とは「選択セルから、全ての方向の最初の空白行・空白列までの領域」で、今回のデータでは図5-18のように「タイトル部+データ部」を全て含んだ範囲になります。
アクティブセル領域とは
図5-18

このアクティブセル領域は「CurrentRegion」プロパティで取得でき、その基準となる選択セルは今回「タイトル部の左下セル(Cells(titleEndRow, titleStartCol))」としています。ここにした理由は、データ領域に隣接しているセルである事からです。

このアクティブセル領域を元に、図5-19のようにデータ範囲(変数DataArea)を求めている式が113行目です。
今回は「タイトル行が存在し、またタイトル行とデータ範囲との間に空白行が無い」ことを前提にしていますので、このような式にしています。もし、タイトル行が無かったり、空白行が存在したりする場合には「指定フォルダ配下のファイル情報取得」を参考にして下さい。
データ領域の求め方
図5-19

データが存在する場合は以上の方法で良いのですが、もしデータが無かったら図5-20のように「データでは無い部分をデータ範囲と誤認」することになってしまいます。
ですので、115行目では「AllArea(AllArea.Count).Row = titleEndRow」の時は、関数プロシージャとして「データが無いことを意味するNothing値」を戻すことにしています。
データが無かった時のデータ領域
図5-20

最後に、118行目で不要になったAllArea変数を解放しています。

5-5-2.データ範囲取得(データ範囲に空白行がある場合)

通常でしたら図5-17の考え方で良いと思うのですが、「複数のデータ抜けが繋がってしまった」とか「項目に余裕を取った」ために、図5-21の様に「データ範囲の中に空白行が出来てしまった」場合には、本来のデータ範囲が取得できない不具合が発生します。
原因は、「CurrentRegion」で取得できる範囲は「空白行・空白列」のところまでのためです。
(ちなみに図5-21の6行目のデータは、図5-3の70行目の「データ範囲補正」コードにより、データ範囲に含まれます。)
データの途中の1行が欠落していた場合のデータ範囲
図5-21

もしこのようなデータが考えられるのであれば、下記図5-22の方法でデータ範囲を取得する必要があります。
  1. '========== ⇩(15) データ範囲取得2 ====================
  2. Private Function DataArea2() As Range
  3.  Dim EndRow As Long       '使用セル範囲の最下行位置
  4.  Dim EndLine As Range      '使用セル範囲の最下行範囲
  5.  EndRow = UsedRange.Row + UsedRange.Rows.Count - 1
  6.  Set EndLine = Range(Cells(EndRow, titleStartCol), Cells(EndRow, titleEndCol))
  7.  Do While Application.WorksheetFunction.CountA(EndLine) = 0
  8.   Set EndLine = EndLine.Offset(-1, 0)
  9.   DoEvents: DoEvents
  10.  Loop
  11.  If EndLine.Row = titleEndRow Then
  12.   Set DataArea2 = Nothing
  13.  Else
  14.   Set DataArea2 = Range(Cells(titleEndRow + 1, titleStartCol), Cells(EndLine.Row, titleendtcol))
  15.  End If
  16.  Set EndLine = Nothing
  17. End Function
図5-22

ここで使用する「UsedRange」は、「ワークシート内の使用しているセル範囲」を取得するプロパティです。
ですので例え見掛けは空白セルであっても、過去にデータが存在したり、書式(含む:文字サイズや罫線等)を変更していれば、「使用している範囲」に含まれます。

まず125行目では、図5-23のようにUsedRangeを使用して「使用範囲の最下行位置(EndRow)」を計算します。
次に、126行目で、タイトルの横方向位置(titleStartCol、titleEndCol)から、「使用範囲の最下行範囲(EndLine)」を求めます。
使用されている範囲と最下段セル範囲(EndLine)
図5-23

次に128~131行目のDo~Loop内では、129行目で最下行範囲(EndLine)を1行ずつ上にあげています。
そのDo~Loopを回す条件は「While Application.WorksheetFunction.CountA(EndLine) = 0」としており、「最下行範囲内に1つも値が無い間」という意味になります。
この条件は128行目の「Do」側に付いているため、「1つでも値があったらDo~Loopが終了」し、終わった後のEndLineの行が「データが存在する最下行位置」ということになります。
(尚、何らかの異常で無限ループになった時にもストップが掛けられるように、130行目にDoEventsコードを入れています。)

このように「EndLine範囲を上に移動させている」理由は、「使用されたセル」では無く「値が入力してあるセル」を取得したいためです。
他に「値が入力してあるセル」を取得する方法としては、下方のセルから「End(xlUp)」で取得するやり方がありますが、10列データがあったら10列全ての列に対して調査が必要になります。
どの手法が処理速度に有利かは、データ次第だと思います。例えば、罫線だけはずっと下まで設定してあるような場合は「End(xlUp)」で取得する方が早いかもしれません。

133~137行目は、最下行範囲(EndLine)の位置で場合分けをしています。
まず「EndLine」がタイトル行まで行ってしまう場合(133行目)は、データが何も無いことを意味していますので、134行目では戻り値としてNothingを代入しています。
それ以外はデータが存在するため、データ先頭行からEndLine行までをデータ範囲として戻り値に代入します。(136行目)
最後に不要となったEndLineオブジェクトを解放します。

尚、データ範囲を取得しているコードは、図5-3の60行目の「Set DataRange = DataArea」ですので、これを「Set DataRange = DataArea2」に変更するだけで「データ範囲取得方法変更」が可能です。

6.Collection法(ワークシートモジュール)

図3-4、図3-5の「Collection法」による並べ替えについて説明します。尚、サンプルファイルでは「Sheet2」になります。

6-1.シートレベル定数の宣言、Collectionの宣言

「並べ替え列追加法」と同様にタイトル部のセル範囲を特定するための定数設定を行うのが141~144行目です。
また今回は「Collection」を使用しますので、145行目でCollectionオブジェクトの宣言を行います。
  1. '========== ⇩(16) シートレベル定数の宣言、Collectionの宣言 ================
  2. Const titleStartRow = 1
  3. Const titleEndRow = 2
  4. Const titleStartCol = 1
  5. Const titleEndCol = 6
  6. Dim UniRange As Collection
図6-1

Collectionの生成方法としては、図6-2のような方法があります。どの方法でもOKですが、今回は方法1を使用しました。
方法1方法2方法3
宣言部Dim UniRange As Collection  Dim UniRange As New Collection
ダブルクリック
プロシージャ内
処理前Set UniRange = New Collection  -Collection値の削除要
処理後Set UniRange = NothingSet UniRange = Nothing  ー
図6-2

尚、方法3を採用する場合は、マクロ終了時(=並べ替え終了時)でもCollection値が残留するため、毎回Collection値の削除工程が必要になります。しかしCollectionオブジェクトには、Dictionaryオブジェクトにあるような「全消去」のメソッドが無いため、For~Nextなどで1つ1つ削除する必要があります。

6-2.ダブルクリックによるイベントプロシージャ

ワークシート上のどこかのセルをダブルクリックすると、図6-3のBeforeDoubleClickイベントが発生します。
  1. '========== ⇩(17) シートレベル定数の宣言、Collectionの宣言 ================
  2. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  3.  If Not Intersect(Target, Range(Cells(titleStartRow, titleStartCol), Cells(titleEndRow, titleEndCol))) Is Nothing Then
  4.   Dim ansUF1 As Long           'ダイアログの戻り値(昇順・降順・キャンセル)
  5.   Dim DataRange As Range         '←データ範囲
  6.   Dim DataStep As Long          '1データの行数
  7.   Dim keyRow As Long           '選択項目のタイトル部内の位置(縦方向)
  8.   Dim keyCol As Long           '選択項目のタイトル部内の位置(横方向)
  9.   Cancel = True
  10.   ansUF1 = UserForm1.UF1_Start
  11.   If ansUF1 = 0 Then Exit Sub       '← 1=昇順、2=降順、0=キャンセル
  12.   Set DataRange = DataArea         '←データ範囲をRange型で取得(右端列加工前に取得)
  13.   If DataRange Is Nothing Then
  14.    MsgBox "データがありません"
  15.    Exit Sub
  16.   End If
  17.   DataStep = titleEndRow - titleStartRow + 1
  18.   keyRow = Target.Row - titleStartRow + 1
  19.   keyCol = Target.Column - titleStartCol + 1
  20.   Set DataRange = DataRange.Resize(Int((DataRange.Rows.Count - 1) / DataStep + 1) * DataStep)
  21.   Set UniRange = New Collection
  22.   Application.ScreenUpdating = False
  23.    Call CollectionRead(DataRange, DataStep, keyRow, keyCol)
  24.    Call CollectionWrite(DataRange, DataStep, ansUF1)
  25.   Application.ScreenUpdating = True
  26.   Set DataRange = Nothing
  27.   Set UniRange = Nothing
  28.  End If
  29. End Sub
図6-3

148行目は「並び替え列追加法」の時と全く同じで、「タイトル部分をダブルクリックしたか」を判断する部分です。
「Intersect(セル範囲A , セル範囲B) 」は、セル範囲Aとセル範囲Bの重なっているセル範囲を返す関数で、「Not Intersect(セル範囲A , セル範囲B) Is Nothing」は「セル範囲Aとセル範囲Bが重なっている部分が存在する場合にTrue」となります。
148行目でのセル範囲Aはダブルクリックしたセル、セル範囲Bはタイトル部ですので、If文は「クリックしたセルがタイトル部だったら」という意味になります。

155行目では、第二引数の「Cancel」にTrueを代入することで「ダブルクリックによるセル編集を中止」にします。
157行目はUserForm1の中の「UF1_Start」関数プロシージャを呼び出し、ユーザーが選択した並び順又はキャンセルを値として変数ansUF1で受け取ります。
158行目は、その変数ansUF1がゼロ(=キャンセル)だった場合にはイベントプロシージャを抜け出し、並べ替え処理を中止します。

160行目ではDataArea関数(図5-17)を呼び出し、戻り値として「データ範囲」を取得し、変数DataRangeに代入します。
しかしデータ行が無かった場合には「Nothing」を戻すことになっているため、161行目で判断し162行目でコメントを出して並べ替えを終了(163行目)します。

166~168行目は、データ範囲の諸元(図6-4)を変数に代入しています。
データ範囲の諸元取得
図6-4

170行目の「Set DataRange = ・・・」は、160行目で取得したデータ範囲(DataRange)の補正をしています。
データ範囲の各行ともデータが埋まっていれば問題無いのですが、例えば図5-7のように1行だけデータが無かった場合には、中途半端なデータ範囲が取得されてしまいます。
データが1行欠落していた時に取得されるデータ範囲
図6-5

そこで、160行目で取得した「データ範囲の行数」と「1データの行数(=タイトル行の行数)」から「正しいはずの行数」を算出し、不足しているならば「データ範囲を下方向に伸ばしている」のです。

但し今回のCollection法では「並び替え列追加法のような致命的な不具合」は発生しません。図6-7の189行目、及び図6-12の210行目・216行目で説明しますが、「1つのデータの先頭行とデータの行数」でデータ範囲を取得するため、最終行が空白行でも「空白のままデータに取り込み」ます。またデータ貼付け時も同様なので問題は発生しません。
ただし、取り込んだデータを貼り付けると「データ範囲の中に空白行が存在」することになってしまうため、次回並び替えを行う時に「空白行より下のデータが無視」されてしまいます。
ですので、もし空白行が出来る可能性のあるデータでしたら170行目は必須ではありませんが、図6-14のUsedRangeを使用したデータ範囲取得は必須となります。

それぞれの手法での「データ範囲の中に空白行が存在」する場合の対応方法を図6-6にまとめました。
ですので、今回Collection法では170行目は必須ではありませんので、削除してもOKです。
(正常な動作には必須ではありませんが、正確なデータ範囲を取得する意味では補正した方が良いかもしれません。)

空白行が出来る可能性のあるデータの対応
並び替え列追加法Collection法
UsedRangeを使用したデータ範囲取得必須必須
データ範囲のデータ行数補正必須無くても正常に動く
図6-6

171行目では、Collectionオブジェクトとして「UniRange」を生成しています。
174行目では「CollectionRead」プロシージャを呼出し、1つずつデータを読み取り、既存のCollectionデータと比較しながら並び順を決めて保管していきます。
175行目では「CollectionWrite」プロシージャを呼出し、保管したCollectionデータをワークシートに貼り付けていきます。

175行目ではワークシート上の値を変更していますので、画面のチラツキ防止と処理速度向上のために、173行目で画面更新停止(Application.ScreenUpdating = False)を行っています。

6-3.Collection値の読み取りと並べ替え

図6-3の174行目から呼び出されるのが図6-7です。引数として受け取る値は、以下の4つです。
 (1)DataRange :データ範囲
 (2)DataStep :1データの行数
 (3)keyRow  :並び替えワードの位置(行方向)
 (4)keyCol  :並び替えワードの位置(列方向)
  1. '========== ⇩(18) Collection値の読み取りと並べ替え ================
  2. Private Sub CollectionRead(DataRange As Range, DataStep As Long, keyRow As Long, keyCol As Long)
  3.  Dim arrayRange As Variant   '1データごとの配列
  4.  Dim i As Long          'カウンタ変数(データの数)
  5.  Dim j As Long          'カウンタ変数(Collection値の数)
  6.  Dim k As Long          'カウンタ変数(データの順番)
  7.  For i = 1 To DataRange.Rows.Count Step DataStep
  8.   arrayRange = DataRange.Rows(i).Resize(DataStep)
  9.   k = 0
  10.   For j = UniRange.Count To 1 Step -1
  11.    If UniRange(j)(keyRow, keyCol) > arrayRange(keyRow, keyCol) Then k = j
  12.   Next j
  13.   If k = 0 Then
  14.    UniRange.Add Item:=arrayRange
  15.   Else
  16.    UniRange.Add Item:=arrayRange, before:=k
  17.   End If
  18.  Next i
  19. End Sub
図6-7

言葉だけでの説明では分かり難いと思いますので、図を交えながら188~200行目の動きを見てみます。
まず1番目のデータの時は、図6-8のようになります。
1つ目のデータを処理する流れ
図6-8

まず188行目のFor~Nextはi=1からスタートします。
189行目は、データ範囲の1行目(DataRange.Rows(i))を行方向に1データの行数分だけ拡張(.Resize(DataStep))した範囲(青い枠の部分)の値を「配列arrayRange」に代入します。
190行目はデータ順序のカウンタ変数を初期化(=0)します。
191行目の「UniRange.Count」はCollectionのデータ数ですが、まだ作られていないので「UniRange.Count=0」です。そうなると191行目のFor文は「For j = 0 To 1 Step -1」となり「Step -1 なので、Jの開始値と終了値が成立しない」ために192行目を実行しないままFor~Next文を終わります。
この時点でK値は変更されていないため K=0 なので、195行目のIf文が成立し196行目を実行します。
196行目は、Collection値として「配列arrayRange」を登録します。
Collection値として登録されたデータは1番目のデータですので、インデックス「1」で管理されます。

次に2番目のデータの時は、図6-9のようになります。
2つ目のデータを処理する流れ
図6-9

まず188行目のFor~Nextは「Step DataStep(今回の場合はDataStep=2)」ですのでi=3です。
189行目は、データ範囲の3行目(DataRange.Rows(i))を行方向に1データの行数分だけ拡張(.Resize(DataStep))した範囲(青い枠の部分)の値を「配列arrayRange」に代入します。
190行目はデータ順序のカウンタ変数を初期化(=0)します。
191行目の「UniRange.Count」はCollectionのデータ数で、1つ作られていますので「UniRange.Count=1」です。
そうなると191行目のFor文は「For j = 1 To 1 Step -1」となりますので、j=1として192行目を実行します。
192行目は、If文で「新規に取り込んだ配列の並び替えワード」と「既存Collectionデータの並び替えワード」を比較しています。もし配列側のワードが小い(=If文が成立)時は、「k=j」を実行します。
図6-9では「みずたに」と「すぎした」を比較し、「みずたに」>「すぎした」ですのでIf文が成立し「k=1」となります。
次に195行目のIf文に入りますが、k=1なので198行目を実行します。198行目は「k番目のデータの前に新しいデータを追加する」という意味ですので、「1番目のデータの前」つまり「新規に取り込んだ配列arrayRange」が1番目のCollection値として登録され、既存のデータは1番目から2番目に変更されます。

もう少しデータの振り分けが進んだ時点の状況を別な角度から見てみます。
図6-10は、既存のCollectionデータが3つあり、「新規に取り込んだ配列」の並び替えワードが「そりまち・・・」である状態です。
データをどこに挿入するかの考え方(間に挿入)
図6-10

191行目のFor~Next文は「Step -1 」となっていますので既存Collectionデータを下の方から調べて行くことになります。
3番目は「みずたに・・・」ですので192行目のIf文は成立し「k=3」となります。続く2番目、1番目との比較は成立しませんので、191~193行目のFor~Nextを抜けた時には「k=3」となっています。
つぎに195~199行目のIf文に入ると、k=3ですので198行目を実行することになります。実行文は「UniRange.Add Item:=arrayRange, before:=k」ですので、「3番目のデータの前に、Collectionデータとして新規配列データを挿入する」ことになります。
すると図6-10の右下のように、並び替えワード「そりまち・・・」の配列データは3番目に入り、従来3番目だった「みずたに・・・」のデータは3番から4番のインデックスに変更になります。

図6-10では新規取得データが「そりまち・・・」でしたが、「わたなべ・・・」だった時の流れを図6-11に示しました。
データをどこに挿入するかの考え方(末尾に追加)
図6-11

191行目のFor~Next文で、既存のCollectionデータと並び替えワードを比較していくのですが、どのワードよりも大きいので192行目のIf文が成立しません。ということは190行目でk値を初期化(k=0)した状態のままですので、191~193行目のFor~Nextを抜けた時には「k=0」となっています。
つぎに195~199行目のIf文に入ると、k=0ですので196行目を実行することになります。実行文は「UniRange.Add Item:=arrayRange」ですので、「Collectionデータとして新規配列データを挿入する」ことになります。挿入する場所を指定しないので、末尾に追加されることになります。
すると図6-10の右下のように、並び替えワード「わたなべ・・・」は4番目になり、従来データのインデックスの順番には変更ありません。

このようにして、「並べ替えワード」順にデータが並んだ状態でCollectionデータが保管されることになります。

6-4.Collection値の貼付け

図6-3の175行目から呼び出されるのが図6-12です。引数として受け取る値は、以下の3つです。
 (1)DataRange :データ範囲
 (2)DataStep :1データの行数
 (3)ansUF1  :並び替え順序(1=昇順、2=降順)
  1. '========== ⇩(19) Collection値のワークシートへの貼付け ================
  2. Private Sub CollectionWrite(DataRange As Range, DataStep As Long, ansUF1 As Long)
  3.  Dim i As Long   'カウンタ変数(貼付け行位置)
  4.  Dim j As Long   'カウンタ変数(Collectionデータのインデックス)
  5.  If ansUF1 = 1 Then    '昇順
  6.   j = 1
  7.   For i = 1 To DataRange.Rows.Count Step DataStep
  8.    DataRange.Rows(i).Resize(DataStep) = UniRange(j)
  9.    j = j + 1
  10.   Next i
  11.  Else            '降順
  12.   j = UniRange.Count
  13.   For i = 1 To DataRange.Rows.Count Step DataStep
  14.    DataRange.Rows(i).Resize(DataStep) = UniRange(j)
  15.    j = j - 1
  16.   Next i
  17.  End If
  18. End Sub
図6-12

このプロシージャは、保管しているCollectionデータをワークシートに「順番に書き出す」のが目的です。ですのでユーザーが指定した順番(昇順・降順)で場合分けをしています。
(本当はIF文ではなく、「昇順=1、降順=2」の値を使って正逆同じコードを考えましたが、上手く思いつきませんでした)
引数として得た「ユーザー指定の順番 ansUF1」の値で、207行目で場合分けをしています。
昇順(ansUF1=1)であれば208~212行目を実行し、降順(ansUF1=2)であれば214~218行目を実行します。

保管しているCollectionデータは図6-7で昇順に既に並べられていますので、昇順の場合は「Collectionデータの並び順で出力」すれば良いことになります。
カウンタ変数jは「Collectionデータのインデックス」を表すものですが、昇順ですので208行目で「j=1」と1番目データからを指定し、211行目で1つ1つ後ろの方にポインターを動かしていきます。
また、209行目のFor~Nextで使用しているカウンタ変数 i は「貼付け場所の行位置」を表しており、各データの先頭行を指定するように「Step DataStep」で間隔を空けています。
210行目では左辺に貼付け場所を各データ先頭行に対して「Resize(DataStep)」で拡張し、Collectionデータを貼り付けています。

一方降順の場合は、214行目で「j = UniRange.Count」とCollectionデータの最後尾データを指定し、217行目で「j = j - 1」と「下のデータから上のデータへ」移動させています。
216行目の貼付け位置については210行目と同じ式です。

6-5.データ範囲取得

データ取得のコードは「並び替え列追加法」と全く同じです。
コードは載せますが説明については「通常のデータ範囲取得」を参照下さい。
  1. '========== ⇩(20) データ範囲取得1 ================
  2. Private Function DataArea() As Range
  3.  Dim AllArea As Range    'CurrentRegionで取得される「タイトル+データの範囲」
  4.  Set AllArea = Cells(titleEndRow, titleStartCol).CurrentRegion
  5.  Set DataArea = Range(Cells(titleEndRow + 1, titleStartCol), Cells(AllArea(AllArea.Count).Row, titleEndCol))
  6.  If AllArea(AllArea.Count).Row = titleEndRow Then
  7.   Set DataArea = Nothing
  8.  End If
  9.  Set AllArea = Nothing
  10. End Function
図6-13

空白行の可能性があるデータ範囲を取得するコードについても、「並び替え列追加法」と全く同じです。
説明については「データ範囲取得(データ範囲に空白行がある場合)」を参照下さい。
  1. '========== ⇩(21)) データ範囲取得2 ================
  2. Private Function DataArea2() As Range
  3.  Dim EndRow As Long     '使用セル範囲の最下行位置
  4.  Dim EndLine As Range    '使用セル範囲の最下行範囲
  5.  EndRow = UsedRange.Row + UsedRange.Rows.Count - 1
  6.  Set EndLine = Range(Cells(EndRow, titleStartCol), Cells(EndRow, titleEndCol))
  7.  Do While Application.WorksheetFunction.CountA(EndLine) = 0
  8.   Set EndLine = EndLine.Offset(-1, 0)
  9.   DoEvents: DoEvents
  10.  Loop
  11.  If EndLine.Row = titleEndRow Then
  12.   Set DataArea2 = Nothing
  13.  Else
  14.   Set DataArea2 = Range(Cells(titleEndRow + 1, titleStartCol), Cells(EndLine.Row, titleendtcol))
  15.  End If
  16.  Set EndLine = Nothing
  17. End Function
図6-14

7.最後に

複数行1データの形式での並び替え方法について紹介しましたが、処理速度については正直あまり考えていません。
並び替え列追加法では1セルずつデータを埋め、またCollection法でもワークシートからの1データずつの読み取りと、1データずつの貼付けを行っているので、大量のデータの場合にはかなり時間が掛かるかもしれませんがご了承下さい。

複数行1データは今回のような手法での並び替えは可能なものの、データ処理には「百害あって一利無し」の並べ方ですので、出来るだけ早く1行1データの状態に改修することをお勧めします。
データを改修する手段として「1行1データの表を複数行1データとして印刷する」の考え方も使えるかもしれません。参考にして下さい。


複数行1データの並び替え(it-043.xlsm)

セキュリティ向上を目的として「インターネット経由でダウンロードしたOfficeファイル(Excel等)のマクロは、既定でブロック」されるようにOfficeアプリケーションの既定動作が変更になりました。(2022年4月より切替開始)
解除の方法については「ダウンロードファイルのブロック解除方法」を参照下さい。