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

最終更新日：2019-06-27

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

マクロVBA練習問題27の解答ページです。

マクロVBA練習問題

アクティブブックのアクティブシートのA列に担当、B列に支店が入っています。
支店ごとのブックを作成して下さい。
作成したブックの保存先は、アクティブブックと同一フォルダとして下さい。

※以下のデータの場合

ブックは「支店A.」「支店B」「支店C」の３つが作成されます。
「支店A」には、
担当者3、担当者7、担当者10、担当者12、担当者14、担当者17
これらがA列に入った状態になります。

※Excelのファイルバージョンは

2007以降ならxlsx、2003以前ならxlsで作成して下さい。

練習問題用のExcelファイル

こちらからダウンロードできます。zipはこちらです。

　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入門

ExcelVBAとはエクセルの操作を自動化するマクロ機能で使われているプログラミング言語ですVBAは「MicrosoftVisualBasicApplications」の略になりますこのVBA入門シリーズでは実務で必要とされるVBAの入門として基本から応用までのVBA全般を解説していきます。

書くべきマクロVBAが分からない時は、
ここでじっくり勉強してから再チャレンジしてください。

マクロVBA練習問題解答

では、解答のマクロ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