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入門では、アクティブブックのアクティブシートだけを扱ってきました。アクティブブックのアクティブシートとは、一番手前に表示されているブックの選択しているシートで、通常、手作業で操作しているシートの事になります。手作業では、アクティブブックのアクティブシートしか扱えませんが、(作業グループで複数の…
第39回.セルのクリア(Clear,ClearContents)
セルをクリアするマクロVBAの書き方です、クリアするといっても、セルの何を(値、書式、コメント等々)クリアするかによって、VBAコードが違ってきます。具体的には、セルの何を(値、書式、コメント等々)クリアするかによって使用するメソッドが変わるという事です。
第40回.セルのコピー・カット&ペースト(Copy,Cut,Paste)
あるセルをコピーまたはカットして、別のセルに貼り付けるマクロVBAの説明です。セルを同じシートの別のセルにコピーしたり、セルを別のシートにコピーしたりするVBAになります。手作業で、セルをコピー(Ctrl+C)またはカット(Ctrl+X)して、他のセルに貼り付け(Ctrl+V後にESCまたはEnter) これと同じ…
第51回.Withステートメント
Withステートメントを使う事で、Withに指定したオブジェクトに対してオブジェクト名を再度記述することなく、プロパティやメソッドを記述することができます。文章で例えて言えば、主語を一度だけ書いて、その後は主語を省略するような書き方になります。
第52回.オブジェクト変数とSetステートメント
変数のデータ型の説明において、Object…オブジェクト型 というのがあった事を覚えているでしょうか。数値や文字ではなく、オブジェクトを入れる変数がオブジェクト変数です。オブジェクトと言っても、いろいろなものがあります。
第62回.「On Error Resume Next」とErrオブジェクト
「OnErrorResumeNext」このステートメントは、実行時エラーが発生してもマクロVBAを中断せずに、エラーが発生したステートメントの次のステートメントから実行を継続します。マクロVBAは、エラーが発生するとその時点で停止してしまいます。
第79回.ファイル操作Ⅰ(Dir)
VBAでは、フォルダのファイル一覧を取得したりファイルの存在確認をする事が出来ます、Dir関数は、指定したパターン(ワイルドカード)やファイル属性と一致するファイルまたはフォルダの名前を表す文字列の値を返します。引数に指定したファイルが存在すると、そのファイル名を返し存在しないと空欄を返します。
第119回.ファイルシステムオブジェクト(FileSystemObject)
FileSystemObjectオブジェクトでは、コンピュータのファイルシステムへのアクセスが提供されています。VBAに用意されているファイル操作関連のステートメントや関数より、より強力で、より多くの機能が搭載されています。ただし機能が大変多いため、これらを全て覚えるという事は困難です。




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

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


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

還暦のVBA:VBAまでたどりつけるか… (2021-09-29)
VLOOKUPを使うことを基本としてシートを設計すべきか|エクセル雑感(2021-08-17)
コンピューターはブラックボックスで良い|エクセル雑感(2021-08-14)
小文字"abc"を大文字"ABC"に変換する方法|エクセル雑感(2021-08-13)
ADOでテキストデータを集計する|VBAサンプル集(2021-08-04)
VBA学習のお勧めコース|エクセル雑感(2021-08-01)
エクセル馬名ダービー|エクセル雑感(2021-07-21)
在庫を減らせ!毎日棚卸ししろ!|エクセル雑感(2021-07-05)
日付型と通貨型のValueとValue2について|エクセル雑感(2021-06-26)
DXってなんだ? ITと何が違うの?|エクセル雑感(2021-06-24)


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

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




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


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



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