練習問題27（データ分割し別ブック保存）回答

最終更新日：2015-10-22

練習問題27（データ分割し別ブック保存）回答

練習問題27の回答ページです、

問題

アクティブブックのアクティブシートのA列に担当、B列に支店が入っています。

支店ごとのブックを作成して下さい。

作成したブックの保存先は、アクティブブックと同一フォルダとして下さい。

※以下のデータの場合、
　　ブックは「支店A.」「支店B」「支店C」の３つが作成されます。
　　「支店A」には、
　　担当者3、担当者7、担当者10、担当者12、担当者14、担当者17
　　がA列に入った状態になります。
※Excelのファイルバージョンは、
　　2007以降ならxlsx、2003以前ならxlsで作成して下さい。

　A　　　　　　B

担当	支店
担当者1	支店B
担当者2	支店C
担当者3	支店A
担当者4	支店B
担当者5	支店C
担当者6	支店C
担当者7	支店A
担当者8	支店B
担当者9	支店C
担当者10	支店A
担当者11	支店B
担当者12	支店A
担当者13	支店B
担当者14	支店A
担当者15	支店B
担当者16	支店C
担当者17	支店A
担当者18	支店B
担当者19	支店C
担当者20	支店C

※上記表の全体選択し、コピー(Ctrl+C)の後、エクセルのシートのA1セルに貼り付け(Ctrl+V)してください。

では、お考えください。

すぐに回答を見ずに、必ず自力で書けるとこまででも良いので書きましょう。

・
・・
・・・
・・・・
・・・・・

当サイトのコンテンツ

ExcelマクロVBA入門

ここで、じっくり勉強して下さい。

・
・・
・・・
・・・・
・・・・・

では、回答です。

Sub 練習問題27()
　　Dim i As Long
　　Dim j As Long
　　Dim oldName As String
　　Dim wb As Workbook
　　Dim ws1 As Worksheet
　　Dim ws2 As Worksheet
　　Application.DisplayAlerts = False
　　Set ws1 = ActiveSheet
　　With ws1
　　　　.Range("A1").Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
　　　　oldName = ""
　　　　For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　　　If oldName <> .Cells(i, 2) Then
　　　　　　　　If oldName <> "" Then
　　　　　　　　　　Call SaveBook(wb, oldName)
　　　　　　　　End If
　　　　　　　　Set wb = Workbooks.Add
　　　　　　　　For j = wb.Worksheets.Count To 2 Step -1
　　　　　　　　　　wb.Worksheets(j).Delete
　　　　　　　　Next
　　　　　　　　Set ws2 = wb.Worksheets(1)
　　　　　　　　ws2.Range("A1") = "担当"
　　　　　　　　j = 2
　　　　　　　　oldName = .Cells(i, 2)
　　　　　　End If
　　　　　　ws2.Cells(j, 1) = .Cells(i, 1)
　　　　　　j = j + 1
　　　　Next
　　End With
　　If oldName <> "" Then
　　　　Call SaveBook(wb, oldName)
　　End If
　　Application.DisplayAlerts = True
End Sub

Sub SaveBook(ByVal wb As Workbook, ByVal strName As String)
　　Dim strFile As String
　　Dim strExt As String
　　If CInt(Application.Version) < 12 Then
　　　　strExt = ".xls"
　　Else
　　　　strExt = ".xlsx"
　　End If
　　strFile = ThisWorkbook.Path & "\" & strName & strExt
　　If Dir(strFile) <> "" Then
　　　　Kill strFile
　　End If
　　wb.SaveAs strFile
　　wb.Close
End Sub

書き方は、人によりかなり違いが出る問題だと思います。

まず支店でSORTしています。
SORTせずにやろうとすると大変な事になってしまいます。
もし、元のシートを変更したくないのであれば、
元のシートをコピーしてからSORTする等で対処した方が良いでしょう。

If oldName <> "" Then
これで、最初の2行目の時、つまり最初の時の制御をしていますが、
ここは、
If Not wb Is Nothing Then
これでも良いですね。
ただオブジェクトを判定するよりString変数を判定した方が解り易いかと思います。

そして、For～Nextの下で、最期のブック出力を忘れないようにして下さい。
このバグは、実務でも結構発生してしまうバグになります。

Subプロシージャー、
SaveBook
このあたりの使い方は是非マスターして欲しいところです。
Subプロシージャー化しないと、無駄にVBAコードが長くなってしまいます。

バージョン判定は、特定バージョンでしか使わないのであれば特に必要はないと思います。

この問題と同様の処理は、実務では頻出します。
私は、幾度となく依頼されて書いているコードです。