Excel VBA データから指定項目のデータを各シートに振り分ける

Sub 転記()
Dim データ範囲 As Range
Dim 条件範囲 As Range
Dim 列 As Long
Dim シート As Worksheet
Dim i As Long
Set データ範囲 = Range("A1").CurrentRegion
    列 = 2
Set 条件範囲 = データ範囲.Cells(1).Offset(0, データ範囲.Columns.Count + 1)
    データ範囲.Columns(列).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=条件範囲, Unique:=True
Set 条件範囲 = 条件範囲.CurrentRegion
For i = 2 To 条件範囲.Rows.Count
    条件範囲.Cells(2, 1).Value = 条件範囲.Cells(i, 1).Value
Set シート = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    シート.Name = 条件範囲.Cells(2, 1).Value
    データ範囲.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=条件範囲.Rows("1:2"), CopyToRange:=シート.Range("A1")
    シート.Range("A1").CurrentRegion.EntireColumn.AutoFit
Next i
    条件範囲.Clear
End Sub

3行目【Dim 条件範囲 As Range】
データの抽出条件があるセルを格納する変数「条件範囲」をオブジェクト型(Range)で宣言します。

4行目【Dim 列 As Long】
抽出条件となる（転記するデータの基準となる）項目の列番号を格納する変数「列」を長整数型(Long)で宣言します。

5行目【Dim シート As Worksheet】
データの転記先となる追加されるワークシートを格納する変数「シート」をオブジェクト型(Worksheet)で宣言します。

6行目【Dim i As Long】
データの抽出条件があるセル範囲が格納されている条件範囲の行番号を格納し、繰り返し処理で使用するカウンター変数「i」を長整数型(Long)で宣言します。

7行目【Set データ範囲 = Range(“A1”).CurrentRegion】
A1セルから始まるデータ範囲をRange【ﾚﾝｼﾞ】オブジェクトのCurrentRegion【ｶﾚﾝﾄﾘｰｼﾞｮﾝ】プロパティを使用してデータ範囲を参照して、オブジェクト変数の「データ範囲」にSetキワードを使用して格納します。

8行目【列 = 2】
転記するデータの基準となる項目の列番号、ここでは2列目の項目「地区」の列番号「2」を変数「列」に代入します。

9行目【Set 条件範囲 = データ範囲.Cells(1).Offset(0, データ範囲.Columns.Count + 1)】
データ範囲をCells【ｾﾙｽﾞ】プロパティで引数を1、つまりここではA1セルを参照して、参照したA1セルからOffset【ｵﾌｾｯﾄ】プロパティで行方向の移動は0、列方向はColumns【ｶﾗﾑｽﾞ】プロパティで列を参照しCount【ｶｳﾝﾄ】プロパティで列数を取得してその列数に1を加算した列、つまり、ここでは「データ範囲.Cells(1).Offset(0,5)」になり、A1セルから数えて5列目を参照することになります。つまり、データ範囲の最終列D列の2列先のF1セルが参照されたことになります。そのセルをオブジェクト変数の「条件範囲」にsetキーワードを使用して代入します。

10行目～11行目【データ範囲.Columns(列).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=条件範囲, Unique:=True】
データ範囲の列をColumns【ｶﾗﾑｽﾞ】プロパティで参照します。

引数に変数「列」を設定します。ここではデータ範囲の2列目の地区の列を参照します。参照した列にフィルターオプションの設定を表すAdvancedFilter【ｱﾄﾞﾊﾞﾝｽﾄﾞﾌｨﾙﾀｰ】メソッドを実行します。

データの抽出先を表す引数Action【ｱｸｼｮﾝ】には引数CopyToRange【ｺﾋﾟｰﾄｩﾚﾝｼﾞ】で指定したセル範囲にデータをコピーして抽出するを表すxlFiltercopyを設定し、その抽出先を表す引数CopyToRange【ｺﾋﾟｰﾄｩﾚﾝｼﾞ】には、オブジェクト変数「条件範囲」を指定します。

重複しているデータを抽出するかどうかを設定する引数Unique【ﾕﾆｰｸ】にTrueを設定して、重複している値は抽出しない設定にします。つまり、2列目の地区のデータの重複する値をのぞいてデータをコピーし、オブジェクト変数「条件範囲」に格納されているF1セルを基準にして地区列のユニーク（重複のない）なデータを貼り付けています。

12行目【Set 条件範囲 = 条件範囲.CurrentRegion】
AdvancedFilter【ｱﾄﾞﾊﾞﾝｽﾄﾞﾌｨﾙﾀｰ】メソッドで抽出したデータ範囲をF1セルが格納されているオブジェクト変数「条件範囲」のデータ範囲を参照するCurrentRegion【ｶﾚﾝﾄﾘｰｼﾞｮﾝ】プロパティを使用してF1セルから始まるデータ範囲を取得して、オブジェクト変数「条件範囲」にsetキーワードを使用して代入します。

13行目【For i = 2 To 条件範囲.Rows.Count】
For Next【ﾌｫｱﾈｸｽﾄ】ステートメントを使用して、繰り返し処理の始まりです。F1セルから始まるデータ範囲が格納されているオブジェクト変数「条件範囲」つまり、AdvancedFilter【ｱﾄﾞﾊﾞﾝｽﾄﾞﾌｨﾙﾀｰ】メソッドで抽出した地区のユニーク（重複の無い）なデータ範囲を行を表すRows【ﾛｳｽﾞ】プロパティで参照して、Count【ｶｳﾝﾄ】プロパティでそのデータ範囲の行数を取得します。そして2～データ範囲の行数を繰り返し処理の中でカウンター変数「i」に順次代入します。

14行目【条件範囲.Cells(2, 1).Value = 条件範囲.Cells(i, 1).Value】
オブジェクト変数「条件範囲」に格納されている、1列目のカウンター変数「i」行目のセルの値をオブジェクト変数「条件範囲」の1列目の2行目に繰り返し処理の中で順次代入します。

15行目【Set シート = Worksheets.Add(after:=Worksheets(Worksheets.Count))】
Worksheets【ﾜｰｸｼｰﾂ】コレクションのAdd【ｱﾄﾞ】メソッドを使用して新しいワークシートを追加して、オブジェクト変数「シート」にSetキーワードを使用して代入します。

16行目【シート.Name = 条件範囲.Cells(2, 1).Value】
追加した新しいシートが格納されている、オブジェクト変数「シート」のName【ﾈｰﾑ】プロパティにオブジェクト変数「条件範囲」の1列目の2行目のセルの値を設定します。つまり、F2セルに設定されている地区の名前を新しいシート名として設定します。

17行目～18行目【データ範囲.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=条件範囲.Rows(“1:2”), CopyToRange:=シート.Range(“A1”)】
データ範囲に、フィルターオプションの設定を表すAdvancedFilter【ｱﾄﾞﾊﾞﾝｽﾄﾞﾌｨﾙﾀｰ】メソッドを実行します。データの抽出先を表す引数Action【ｱｸｼｮﾝ】には引数CopyToRange【ｺﾋﾟｰﾄｩﾚﾝｼﾞ】で、指定したセル範囲にデータをコピーして抽出するを表すxlFiltercopyを設定し、その抽出先を表す引数CopyToRange【ｺﾋﾟｰﾄｩﾚﾝｼﾞ】には、新しく追加したワークシートを表すオブジェクト変数「シート」のA1セルを指定します。

ワークシート上に作成した抽出条件を表す引数CriteriaRange【ｸﾗｲﾃﾘｱﾚﾝｼﾞ】にはオブジェクト変数「条件範囲」のRows【ﾛｳｽﾞ】プロパティで1行目と2行目を指定します。

条件範囲の1～2行目の値の条件でデータ範囲からAdvancedFilter【ｱﾄﾞﾊﾞﾝｽﾄﾞﾌｨﾙﾀｰ】メソッドでデータを抽出し、新しく追加したシートのA1セルに抽出したデータを貼り付けます。

19行目【シート.Range(“A1”).CurrentRegion.EntireColumn.AutoFit　】
オブジェクト変数「シート」に格納されているワークシートのA1セルを基準に、CurrentRegion【ｶﾚﾝﾄﾘｰｼﾞｮﾝ】プロパティでデータ範囲を参照してそのすべての列を表すEntireColumn【ｴﾝﾀｰｶﾗﾑ】プロパティで全体列を参照しAutoFit【ｵｰﾄﾌｨｯﾄ】メソッドを使用して列幅を調整します。

20行目【Next i】
13行目～ここまでの処理をオブジェクト変数「条件範囲」の行数分繰り返します。

21行目【条件範囲.Clear】
繰り返し処理を抜けたあと、データ範囲に作成したオブジェクト変数「条件範囲」に格納された、セル範囲をClear【ｸﾘｱ】メソッドを使用して削除します。