Excelで指定した団体コード毎にシートを分割するVBA

##経緯
シートを分割するのがクソだるいのでつくりました。

##ゴール
Sheet1にあるデータを、Sheet2で指定した分だけ、
こんな感じで複数シートに分割します。
![スクリーンショット 2019-08-15 16.12.08.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/45456544-c34c-8f22-4e7c-487aff3e2fa4.jpeg)

##データの準備
###分割したいデータ
まず、分割元のシート（Sheet1）です。
一番左端に数値で示された団体キーがあり、昇順に並んでます。
団体キーの項目名が　0　ですが、あえてです。

```CSV
0,ColumnData1,ColumnData2,ColumnData3,ColumnData4,ColumnData5,ColumnData6,ColumnData7,ColumnData8,ColumnData9
4321,hhhhh-1-1,hhhhh-2-1,hhhhh-3-1,hhhhh-4-1,hhhhh-5-1,hhhhh-6-1,hhhhh-7-1,hhhhh-8-1,hhhhh-9-1
4321,hhhhh-1-2,hhhhh-2-2,hhhhh-3-2,hhhhh-4-2,hhhhh-5-2,hhhhh-6-2,hhhhh-7-2,hhhhh-8-2,hhhhh-9-2
4321,hhhhh-1-3,hhhhh-2-3,hhhhh-3-3,hhhhh-4-3,hhhhh-5-3,hhhhh-6-3,hhhhh-7-3,hhhhh-8-3,hhhhh-9-3
4321,hhhhh-1-4,hhhhh-2-4,hhhhh-3-4,hhhhh-4-4,hhhhh-5-4,hhhhh-6-4,hhhhh-7-4,hhhhh-8-4,hhhhh-9-4
4321,hhhhh-1-5,hhhhh-2-5,hhhhh-3-5,hhhhh-4-5,hhhhh-5-5,hhhhh-6-5,hhhhh-7-5,hhhhh-8-5,hhhhh-9-5
111111,aaaaa-1-1,aaaaa-2-1,aaaaa-3-1,aaaaa-4-1,aaaaa-5-1,aaaaa-6-1,aaaaa-7-1,aaaaa-8-1,aaaaa-9-1
111111,aaaaa-1-2,aaaaa-2-2,aaaaa-3-2,aaaaa-4-2,aaaaa-5-2,aaaaa-6-2,aaaaa-7-2,aaaaa-8-2,aaaaa-9-2
111111,aaaaa-1-3,aaaaa-2-3,aaaaa-3-3,aaaaa-4-3,aaaaa-5-3,aaaaa-6-3,aaaaa-7-3,aaaaa-8-3,aaaaa-9-3
111111,aaaaa-1-4,aaaaa-2-4,aaaaa-3-4,aaaaa-4-4,aaaaa-5-4,aaaaa-6-4,aaaaa-7-4,aaaaa-8-4,aaaaa-9-4
111111,aaaaa-1-5,aaaaa-2-5,aaaaa-3-5,aaaaa-4-5,aaaaa-5-5,aaaaa-6-5,aaaaa-7-5,aaaaa-8-5,aaaaa-9-5
111111,aaaaa-1-6,aaaaa-2-6,aaaaa-3-6,aaaaa-4-6,aaaaa-5-6,aaaaa-6-6,aaaaa-7-6,aaaaa-8-6,aaaaa-9-6
111111,aaaaa-1-7,aaaaa-2-7,aaaaa-3-7,aaaaa-4-7,aaaaa-5-7,aaaaa-6-7,aaaaa-7-7,aaaaa-8-7,aaaaa-9-7
123456,ggggg-1-1,ggggg-2-1,ggggg-3-1,ggggg-4-1,ggggg-5-1,ggggg-6-1,ggggg-7-1,ggggg-8-1,ggggg-9-1
123456,ggggg-1-2,ggggg-2-2,ggggg-3-2,ggggg-4-2,ggggg-5-2,ggggg-6-2,ggggg-7-2,ggggg-8-2,ggggg-9-2
123456,ggggg-1-3,ggggg-2-3,ggggg-3-3,ggggg-4-3,ggggg-5-3,ggggg-6-3,ggggg-7-3,ggggg-8-3,ggggg-9-3
123456,ggggg-1-4,ggggg-2-4,ggggg-3-4,ggggg-4-4,ggggg-5-4,ggggg-6-4,ggggg-7-4,ggggg-8-4,ggggg-9-4
123456,ggggg-1-5,ggggg-2-5,ggggg-3-5,ggggg-4-5,ggggg-5-5,ggggg-6-5,ggggg-7-5,ggggg-8-5,ggggg-9-5
222222,bbbbb-1-1,bbbbb-2-1,bbbbb-3-1,bbbbb-4-1,bbbbb-5-1,bbbbb-6-1,bbbbb-7-1,bbbbb-8-1,bbbbb-9-1
222222,bbbbb-1-2,bbbbb-2-2,bbbbb-3-2,bbbbb-4-2,bbbbb-5-2,bbbbb-6-2,bbbbb-7-2,bbbbb-8-2,bbbbb-9-2
222222,bbbbb-1-3,bbbbb-2-3,bbbbb-3-3,bbbbb-4-3,bbbbb-5-3,bbbbb-6-3,bbbbb-7-3,bbbbb-8-3,bbbbb-9-3
333333,ccccc-1-1,ccccc-2-1,ccccc-3-1,ccccc-4-1,ccccc-5-1,ccccc-6-1,ccccc-7-1,ccccc-8-1,ccccc-9-1
333333,ccccc-1-2,ccccc-2-2,ccccc-3-2,ccccc-4-2,ccccc-5-2,ccccc-6-2,ccccc-7-2,ccccc-8-2,ccccc-9-2
333333,ccccc-1-3,ccccc-2-3,ccccc-3-3,ccccc-4-3,ccccc-5-3,ccccc-6-3,ccccc-7-3,ccccc-8-3,ccccc-9-3
333333,ccccc-1-4,ccccc-2-4,ccccc-3-4,ccccc-4-4,ccccc-5-4,ccccc-6-4,ccccc-7-4,ccccc-8-4,ccccc-9-4
333333,ccccc-1-5,ccccc-2-5,ccccc-3-5,ccccc-4-5,ccccc-5-5,ccccc-6-5,ccccc-7-5,ccccc-8-5,ccccc-9-5
444444,ddddd-1-1,ddddd-2-1,ddddd-3-1,ddddd-4-1,ddddd-5-1,ddddd-6-1,ddddd-7-1,ddddd-8-1,ddddd-9-1
444444,ddddd-1-2,ddddd-2-2,ddddd-3-2,ddddd-4-2,ddddd-5-2,ddddd-6-2,ddddd-7-2,ddddd-8-2,ddddd-9-2
444444,ddddd-1-3,ddddd-2-3,ddddd-3-3,ddddd-4-3,ddddd-5-3,ddddd-6-3,ddddd-7-3,ddddd-8-3,ddddd-9-3
444444,ddddd-1-4,ddddd-2-4,ddddd-3-4,ddddd-4-4,ddddd-5-4,ddddd-6-4,ddddd-7-4,ddddd-8-4,ddddd-9-4
555555,eeeee-1-1,eeeee-2-1,eeeee-3-1,eeeee-4-1,eeeee-5-1,eeeee-6-1,eeeee-7-1,eeeee-8-1,eeeee-9-1
555555,eeeee-1-2,eeeee-2-2,eeeee-3-2,eeeee-4-2,eeeee-5-2,eeeee-6-2,eeeee-7-2,eeeee-8-2,eeeee-9-2
555555,eeeee-1-3,eeeee-2-3,eeeee-3-3,eeeee-4-3,eeeee-5-3,eeeee-6-3,eeeee-7-3,eeeee-8-3,eeeee-9-3
555555,eeeee-1-4,eeeee-2-4,eeeee-3-4,eeeee-4-4,eeeee-5-4,eeeee-6-4,eeeee-7-4,eeeee-8-4,eeeee-9-4
666666,fffff-1-1,fffff-2-1,fffff-3-1,fffff-4-1,fffff-5-1,fffff-6-1,fffff-7-1,fffff-8-1,fffff-9-1
666666,fffff-1-2,fffff-2-2,fffff-3-2,fffff-4-2,fffff-5-2,fffff-6-2,fffff-7-2,fffff-8-2,fffff-9-2
```

実際のシート（Sheet1）はこんな感じ。
この左端の数値を次のSheet2で指定して、複数シートへ切り出します。
![スクリーンショット 2019-08-15 16.23.19.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/983a5c07-71d7-2d7e-cbfd-b88e1be8dbf5.jpeg)

試すときは、新規ブック開いて、マクロ有効形式（.xlsm）で保存したら、
Sheet1に分割したいデータを貼り付けるなりインポートしておけばいいと思います。

###切り出したい団体を指定
次に、指定する団体をSheet2に書いておきます。
```
CITY
4321
111111
123456
222222
333333
444444
555555
666666
```

実際のシート（Sheet2）のイメージはこんな感じ。
![スクリーンショット 2019-08-15 16.29.33.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/ec92e0d0-0a1a-c6c8-26f0-659ba0498038.jpeg)

一部指定でもおｋ。
![スクリーンショット 2019-08-15 16.28.32.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/25de7b45-31cb-609d-92e3-b6b9032545ab.jpeg)


準備OK．
![スクリーンショット 2019-08-15 16.43.29.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/34348b6b-7427-35eb-4b09-bf23ecbd946f.jpeg)

##VBAの準備
最後にVBA。

```
Option Explicit

Sub Sheet1をSheet2と突合し分割()
'各マスタの行数・列数を取得
   'CITYマスタの最終行数
   Dim rowsSheet2 As Long
   rowsSheet2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
   
   'DATAマスタの最終行数
   Dim rowsSheet1 As Long
   rowsSheet1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
   'DATAマスタの最終列数
   Dim colsData As Long
   colsData = Sheet1.Cells(1, Columns.Count).End(xlToRight).Column
   '突合ループ内で突合するDATAの範囲(開始位置)行数（初期値）
   Dim searchRangeStart As Long
   'DATAマスタの先頭
   searchRangeStart = "1"
   '突合ループ内で突合するDATAの範囲(終了位置)行数（初期値）
   Dim searchRangeEnd As Long
   'DATAマスタの最終行数
   searchRangeEnd = rowsSheet1
'突合ループ
   '突合ループ用変数宣言
   Dim n As Long
   Dim m As Long
   '突合成功フラグ
   Dim matchFlag As Integer
   matchFlag = 0 '倒しておく
   '突合範囲スタートエンド
   Dim matchRangeStart As Long
   Dim matchRangeEnd As Long
          
   'CITYのはじめから終わりまで
   For n = 2 To rowsSheet2
           Sheet2.Select
           Dim k As Long
           k = Sheet2.Cells(n, 1).Value
   
       'DATAのCITYごとの範囲で
       For m = 1 To searchRangeEnd
       
           Sheet1.Select
           Dim l As Long
           l = Sheet1.Cells(m, 1).Value
           
           'CITYコードが一致
           If k = l Then
               '突合フラグが立ってなかったら、立てる（突合中CITYコードの最初のヒット）
               If matchFlag = 0 Then
                   matchRangeStart = m
                   matchFlag = 1
               End If
           End If
           
           '突合検索がDATA最終行まで到達
           If m = searchRangeEnd Then
               '直前までに突合していれば、
               If matchFlag = 1 Then
                   '突合範囲を確定
                   matchRangeEnd = m
                   '新規ワークシートを開き、突合選択中のCITY名称を設定、オブジェクト指定する
                   Worksheets.Add
                   ActiveSheet.Name = Sheet2.Cells(n, 1).Value
                   Dim wsi As Worksheet
                   Set wsi = ActiveSheet
                   '作成したワークシートに突合範囲を行ごとコピーする
                   Sheet1.Range(matchRangeStart & ":" & matchRangeEnd).Copy wsi.Range("A1")
                   'フラグ倒す
                   matchFlag = 0
               End If
           End If
           
           'CITYコードが不一致
           If k < l Then
               '直前までに突合していれば、
               If matchFlag = 1 Then
                   '突合範囲を確定（一つ前の行迄）
                   matchRangeEnd = m - 1
                   '新規ワークシートを開き、突合選択中のCITY名称を設定、オブジェクト指定する
                   Worksheets.Add
                   ActiveSheet.Name = Sheet2.Cells(n, 1).Value
                   Dim wsj As Worksheet
                   Set wsj = ActiveSheet
                   '作成したワークシートに突合範囲を行ごとコピーする
                   Sheet1.Range(matchRangeStart & ":" & matchRangeEnd).Copy wsj.Range("A1")
                   'フラグ倒す
                   matchFlag = 0
               End If
               'DATAとの突合ループmを抜ける
               Exit For
           End If
           
       Next m
   Next n
End Sub

```

開発＞VisualBasicエディターから、標準モジュールに保存しておきます。


##実行

そぉい！
![スクリーンショット 2019-08-15 16.45.25.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/10a8973b-df81-a275-bd60-c718aaf8af18.jpeg)

##結果
できました。
![スクリーンショット 2019-08-15 16.12.08.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/18f12db8-a7d7-fc9a-56ce-c22e12ca9118.jpeg)

分割したシートはこんな感じ。
![スクリーンショット 2019-08-15 16.47.32.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/4c35956a-f5ee-e236-41d8-18513b40c40b.jpeg)
![スクリーンショット 2019-08-15 16.47.50.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/db01009c-0329-32b7-a123-269a86f0b0ae.jpeg)
![スクリーンショット 2019-08-15 16.48.15.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/69ff29cb-f02f-5d99-e8a2-ecc309e2e64e.jpeg)


一部指定で実行したとき。
![スクリーンショット 2019-08-15 16.28.17.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/151818/5a4b76ff-ddcd-69f0-9442-fba983538d40.jpeg)
指定したものだけシート生成されてます。


やり直すときは、生成されたシートを削除して、Sheet1・Sheet2だけの状態に戻してから。

##所感

うまくできたぽい。しらんけど！