10万行以上のデータを約100グループごとに分割して、グループ名をつけて別ブックに保存していくという結構な手間のかかる作業を一定期間ごとにやっています
現在は、この作業をVBAを使って自動で１０分以内に完了させています
分割するための設定を「分割設定」シートにあらかじめ設定させておけば、次回からは「実行」ボタンをクリックするだけで自動的に作成してくれるようになっています
大分前のことなのですが、その時にどうやってVBAを書いていったのかを思い出しながら書いておきます。内容が結構盛沢山になりそうなので、1回では終わらないかもしれませんが・・・(^^;
グループごとのデータをフィルタを使って分割し別ブックに保存していく記事（前半）
ロジックを検討する
はじめに分割前のデータについていろいろ検証してみました
・元データは改変してはいけない設定
・元データ（対象ブック・シート）をコピーしてから使う
・元データのまま使っても、分割後のファイル名で保存すれば元データはそのまま
・元データには列のタイトルのほかに、表のタイトルや見出しなどがある場合が多い
（しかもセルが結合されているケースが多い）
・元データ表の最下部に注意書きなどのコメントが記入されていることがある
・分割方法は（データがランダムの場合）
①対象の項目列でソートしてから同一項目を選択して抜き出す方法
②フィルタで分割対象項目を絞って、対象以外を削除してしまう方法
（でもソートしてから実行した方が速いはず）
・元ブックには対象データシート以外のシートも存在している（説明書など）
・分割対象のシート（リスト）が複数シートある場合もあり
（複数シートの分割も可能にしたい）
「基本的なところはこんな感じ」
ロジックの検討
・処理の流れ（フローチャート）はこんな感じ
・データの抽出方法もいくつか考えられます
・まず思いつくのはソートして揃える方法ですよね
・でも、選んだのはフィルタを使う方法にしました
・フィルタで目的データ以外を抽出し、それを削除しちゃいます
・それから、フィルタを解除すれば目的データだけが残っているという方法です
重複のないリストを作成する方法の検討
・大量の列データからVBAで重複のないユニークリストをつくる主な方法は次のようなものです
（ワークシート上で手作業でつくる方法は除いています）
・Dictionaryオブジェクト（連想配列）を使う方法
・Collectionオブジェクト を使う方法
・フィルタを使う方法
・フィルタオプション（AdvancedFilterのUnique:=True）を使う方法
Dictionaryオブジェクト（連想配列）を使ったコード
'重複しないリストを格納する (Dictionaryオブジェクト使用)
Sub Sample_Dictionary()
Dim uDic As Object, i As Long, buf As String, uKeys As Variant
Set uDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
With Worksheets("Sheet1")
For i = 1 To .Cells(1, 1).CurrentRegion.Count
buf = Cells(i, 1).Value
uDic.Add buf, buf
Next
End With
uKeys = uDic.Keys 'Variant型の配列へ格納（(0)は見出し）
Set uDic = Nothing
End SubCollectionオブジェクト を使ったコード
'重複しないリストをuKeysに格納する（Collectionオブジェクト使用）
Sub Sample_Collection()
Dim uKeys As New Collection 'Collectionオブジェクト
Dim u As Long
With Worksheets("Sheet1")
On Error Resume Next 'データ重複エラーを無視する
For u = 1 To .Cells(1, 1).CurrentRegion.Count
uKeys.Add .Cells(u, 1).Value, .Cells(u, 1).Value 'uKeysに格納
Next
On Error GoTo 0
End With
End Subフィルタを使ったコード
'重複しないリストを格納する（フィルタ使用）
Sub Sample_Filter()
Dim uKeys As Variant
With Worksheets("Sheet1")
.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
With .Cells(1, 1).CurrentRegion
uKeys = .Resize(.Rows.Count - 1).Offset(1).Value '２次元配列になる
End With
End With
End Subフィルタオプション（Unique:=True）を使ったコード
'重複しないリストを格納する（フィルタオプションのUnique:=Trueを使用した例）
Sub sample_FilterOption()
Dim LastRow As Long
Dim uKeys As Range
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range(.Cells(1, 1), .Cells(LastRow, 1)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Cells(1, 2), _
Unique:=True
'一旦列に書き出してからオブジェクトに格納しなければならない
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
Set uKeys = .Range(.Cells(1, 2), .Cells(LastRow, 2))
End With
End Subどのコードを使うか検討した結果
【決定】Collectionオブジェクト を使ったコードに決めました！
【理由】扱いやすい
【コード全体の評価】どのコードも速度としては大差ありませんでした
・Dictionaryは配列に格納して使う
・フィルタを使った場合、２次元配列になる
・フィルタオプションの場合、一旦シートに書き出してから配列等に格納する手間
・Collectionオブジェクトが一番扱いやすいと思いました
まとめ
ここまでの「まとめ」と感想
・データ表から同一種別データ毎に抽出して別ファイルに分割保存する方法の記事NO1
・分割前の元データについて検証した結果、いろいろなことがわかりました
・分かったことをもとに、処理の流れ（ロジック）を作成
・データ分割するための元となる「ユニークデータ」の作成方法を検討
・検討した結果「Collectionオブジェクト」を使うことに決定しました
次回の記事、そして今後は
今回の記事はいかがだったでしょうか。お役に立てたなら幸いです
次の記事は今回記事の続きです。しばしお待ちください(^^)
・データ表から同一種別データ毎に抽出して別ファイルに分割保存する方法NO2
【今後の記事内容はどうしようかなぁ・・・】
・ExcelからOutlook 2016でメールを送信する方法
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/
サンプルファイルをダウンロードできます（下記リンク先へ）ただし、今回記事については次回記事と合わせてアップします
・今回記事については、コードをCOPYしてご利用ください
・次回の記事とあわせてサンプルファイルをアップしますのでお待ちくださいm(_ _)m
