VBA練習問題
VBA100本ノック 40本目:複数ブックの統合

VBAを100本の練習問題で鍛えます
最終更新日:2021-01-13

VBA100本ノック 40本目:複数ブックの統合


指定フォルダ内のExcelブックから指定シートを集めてくる問題です。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。


出題

出題ツイートへのリンク

#VBA100本ノック 40本目
「data」フォルダ内のExcelファイルについて、シート「2020年12月」のA1からの連続表範囲を集めます。※このシートが無いファイルもある。
自身の既存シート「2020年12月」に集めてください。
1行目は見出しなので2件目からは除く。
※ブック指定と「data」のパス位置は任意

マクロ VBA 100本ノック


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解説

実務でVBAを使っていれば、一度は似たような処理を書いたことがある人は多いのではないでしょうか。
フォルダ内のファイル取得は、100本ノックでも既出です。
今回はExcelファイルを開いてシート確認&データコピーが追加されたものです。
見出し行のコピー制御が若干面倒ですね。

Sub VBA100_40_01()
  Const shtName = "2020年12月"
  Dim wb As Workbook: Set wb = ThisWorkbook
  Dim ws As Worksheet: Set ws = wb.Worksheets(shtName)
  Dim sPath As String: sPath = wb.Path & "\data\"
  Dim sFile As String
  Dim wbT As Workbook, wsT As Worksheet
  Dim outRow As Long, offsetRow As Long
  
  ws.Cells.Clear
  sFile = Dir(sPath & "*.xlsx")
  Do While sFile <> ""
    Set wbT = Workbooks.Open(FileName:=sPath & sFile, UpdateLinks:=0, ReadOnly:=True)
    Set wsT = getWorksheet(wbT, shtName)
    If Not wsT Is Nothing Then
      outRow = ws.Range("A1").CurrentRegion.Rows.Count + offsetRow
      wsT.Range("A1").CurrentRegion.Offset(offsetRow).Copy ws.Cells(outRow, 1)
      offsetRow = 1
    End If
    wbT.Close SaveChanges:=False
    sFile = Dir()
  Loop
End Sub

Function getWorksheet(ByVal wb As Workbook, ByVal aName As String) As Worksheet
  On Error Resume Next
  Set getWorksheet = wb.Worksheets(aName)
End Function


上記では、offsetRowでコピー範囲及び貼り付け先の1行ずらしを一緒に制御してみました。
ここは難しくはないのですが、どうしても記述が面倒になってしまうのは仕方ないように思います。
この辺りを少し記述を変えて、FSOを使った参考VBAを記事補足に掲載しました。


補足

先のVBAでは、Applicationのプロパティ設定を省略しましたが、やはり入れたほうが良いと思います。
再計算の停止については、読み込むファイルの事情(再計算が重い等)によって適宜対応してください。

シートの確認は、存在チェックというより指定名称のシート取得するだけなので、
On Errorを使って簡易に済ませています。

Sub VBA100_40_02()
  Const shtName = "2020年12月"
  Dim wb As Workbook: Set wb = ThisWorkbook
  Dim ws As Worksheet: Set ws = wb.Worksheets(shtName)
  Dim sPath As String: sPath = wb.Path & "\data"
  Dim wbT As Workbook, wsT As Worksheet
  Dim outRow As Long, offsetRow As Long
  
  Dim objFso As Object, objFolder As Object, objFile As Object
  Set objFso = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFso.GetFolder(sPath)
  
  Call setApp(False)
  
  ws.Cells.Clear
  outRow = 1
  For Each objFile In objFolder.Files
    If objFso.GetExtensionName(objFile.Name) = "xlsx" Then
      Set wbT = Workbooks.Open(FileName:=objFile.Path, UpdateLinks:=0, ReadOnly:=True)
      Set wsT = getWorksheet(wbT, shtName)
      If Not wsT Is Nothing Then
        offsetRow = IIf(outRow = 1, 0, 1)
        wsT.Range("A1").CurrentRegion.Offset(offsetRow).Copy ws.Cells(outRow, 1)
        outRow = outRow + wsT.Range("A1").CurrentRegion.Rows.Count - offsetRow
      End If
      wbT.Close SaveChanges:=False
    End If
  Next
  
  Call setApp(True)
End Sub

Function getWorksheet(ByVal wb As Workbook, ByVal aName As String) As Worksheet
  On Error Resume Next
  Set getWorksheet = wb.Worksheets(aName)
End Function

Sub setApp(ByVal arg As Boolean)
  With Application
    .Calculation = IIf(arg, xlCalculationAutomatic, xlCalculationManual)
    .DisplayAlerts = arg
    .ScreenUpdating = arg
  End With
End Sub


サイト内関連ページ

第37回.ブック・シートの指定
・マクロVBAでのブック・シート指定の具体例 ・マクロVBAでのブック・シート指定の必要性 ・VBAでの色々なシート指定方法
第39回.セルのクリア(Clear,ClearContents)
・セル(Rangeオブジェクト)のクリア関係のメソッド(動作を与える) ・Range.Clear ・Range.ClearContents ・クリア関係メソッドについて
第40回.セルのコピー・カット&ペースト(Copy,Cut,Paste)
・セルをコピー(複写)する場合 ・セルを切り取る(移動する)場合 ・セル範囲のコピーについて ・別のシートにコピーする場合 ・アクティブシート以外へのコピー ・セルのコピーについてのサイト内参考ページ
第51回.Withステートメント
・Withの構文 ・Withを使った時と使わない時の比較 ・Withの使用例 ・Withのネスト ・Withを使ったときに気を付けるべき書き方 ・Withの使いどころ ・サイト内の参考ページ
第52回.オブジェクト変数とSetステートメント
・オブジェクト変数 ・個有のオブジェクト型とは ・Setステートメント ・Setステートメントの使用例 ・WithとSetの使い分け方 ・Setステートメントの実践的な使い方 ・Is演算子によるオブジェクトの比較 ・最後に
第62回.「On Error Resume Next」とErrオブジェクト
・On Error Resume Next ・Errオブジェクト ・On Error Resume Next の使用例 ・「On Error Resume Next」の最後に
第79回.ファイル操作Ⅰ(Dir)
・Dir関数 ・Dir関数の使用例 ・Dir関数の実践例 ・Dir関数の制限について ・Dir関数の関連記事
第119回.ファイルシステムオブジェクト(FileSystemObject)
・FileSystemObjectオブジェクトの使用方法 ・FileSystemObjectオブジェクトのプロパティとメソッド ・FileSystemObjectオブジェクトのメソッドの戻り値 ・FileSystemObjectオブジェクトの使用例 ・FileSystemObjectオブジェクトの関連記事と実践例




同じテーマ「VBA100本ノック」の記事

37本目:グラフの色設定
38本目:1シートを複数シートに振り分け
39本目:数値リストの統合(マージ)
40本目:複数ブックの統合
41本目:暗算練習アプリ
42本目:データベース形式に変換
43本目:CSV出力
44本目:全テーブル一覧作成
45本目:テーブルに列追加
46本目:名前定義に使える文字
47本目:Window操作


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

TOROW関数(配列を横1行の配列にして返す)|エクセル入門(2022-10-31)
TOCOL関数(配列を縦1列の配列にして返す)|エクセル入門(2022-10-31)
CHOOSECOLS関数(配列から複数の指定された列を返す)|エクセル入門(2022-10-29)
CHOOSEROWS関数(配列から複数の指定された行を返す)|エクセル入門(2022-10-29)
WorksheetFunctionの効率的な使い方とスピル新関数の利用|VBA入門(2022-10-27)
VSTACK関数(配列を縦方向に順に追加・結合)|エクセル入門(2022-10-25)
HSTACK関数(配列を横方向に順に追加・結合)|エクセル入門(2022-10-25)
LAMBDA以降の新関数の問題と解説(配列操作関数編)|エクセル入門(2022-10-24)
LAMBDA以降の新関数の問題と解説(ヘルパー関数編)|エクセル入門(2022-10-24)
LAMBDA以降の新関数の問題集|エクセル入門(2022-10-24)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.並べ替え(Sort)|VBA入門
8.マクロって何?VBAって何?|VBA入門
9.エクセルVBAでのシート指定方法|VBA技術解説
10.ExcelマクロVBAの基礎を学習する方法|エクセルの神髄




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


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



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