ExcelマクロVBA練習問題解答
練習問題27(データ分割し別ブック保存)解答

Excelマクロ練習問題集、エクセルVBAの学習教材
最終更新日:2019-06-27

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

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

マクロVBA練習問題

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

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

練習問題用のExcelファイル
 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

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

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

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

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

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

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

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



同じテーマ「マクロVBA練習問題解答」の記事

練習問題19(総合練習1)解答
練習問題20(総合練習2)解答
練習問題21(総合練習3)解答
練習問題22(総合練習4)解答
練習問題23(総合練習5)解答
練習問題24(再帰呼出し)解答
練習問題25(各種VBA関数)解答
練習問題26(全シート処理とハイパーリンク)解答
練習問題27(データ分割し別ブック保存)解答
練習問題28(シートを別ブックにして値のみにする)解答
練習問題29(ロット引き当て)解答


新着記事NEW ・・・新着記事一覧を見る

CSVの読み込み方法(ジャグ配列)|VBAサンプル集(7月15日)
その他のExcel機能(グループ化、重複の削除、オートフィル等)|VBA入門(7月14日)
オートフィルタ退避回復クラスを複数シート対応させるVBAクラス|VBA技術解説(7月6日)
オートフィルタを退避回復するVBAクラス|VBA技術解説(7月6日)
IfステートメントとIIF関数とMax関数の速度比較|VBA技術解説(6月23日)
Withステートメントの実行速度と注意点|VBA技術解説(6月6日)
VBA+SeleniumBasicで検索順位チェッカー(改)|VBA技術解説(6月2日)
マクロでShift_JIS文字コードか判定する|VBA技術解説(6月1日)
Shift_JISのテキストファイルをUTF-8に一括変換|VBAサンプル集(5月31日)
「VBAによる解析シリーズその2 カッコ」をやってみた|エクセル(5月21日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.RangeとCellsの使い方|ExcelマクロVBA入門
4.変数とデータ型(Dim)|ExcelマクロVBA入門
5.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
6.繰り返し処理(For Next)|ExcelマクロVBA入門
7.マクロって何?VBAって何?|ExcelマクロVBA入門
8.ひらがな⇔カタカナの変換|エクセル基本操作
9.ExcelマクロVBAの基礎を学習する方法|エクセルの神髄
10.空白セルを正しく判定する方法(IsEmpty,IsError,HasFormula)|VBA技術解説



  • >
  • >
  • >
  • 練習問題27(データ分割し別ブック保存)解答

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。




    このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
    本文下部へ