VBA100本ノック 40本目：複数ブックの統合
指定フォルダ内のExcelブックから指定シートを集めてくる問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
出題
出題ツイートへのリンク
#VBA100本ノック 40本目
「data」フォルダ内のExcelファイルについて、シート「2020年12月」のA1からの連続表範囲を集めます。※このシートが無いファイルもある。
自身の既存シート「2020年12月」に集めてください。
1行目は見出しなので2件目からは除く。
※ブック指定と「data」のパス位置は任意
「data」フォルダ内のExcelファイルについて、シート「2020年12月」のA1からの連続表範囲を集めます。※このシートが無いファイルもある。
自身の既存シート「2020年12月」に集めてください。
1行目は見出しなので2件目からは除く。
※ブック指定と「data」のパス位置は任意
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
実務でVBAを使っていれば、一度は似たような処理を書いたことがある人は多いのではないでしょうか。
フォルダ内のファイル取得は、100本ノックでも既出です。
今回はExcelファイルを開いてシート確認&データコピーが追加されたものです。
見出し行のコピー制御が若干面倒ですね。
上記では、offsetRowでコピー範囲及び貼り付け先の1行ずらしを一緒に制御してみました。
ここは難しくはないのですが、どうしても記述が面倒になってしまうのは仕方ないように思います。
この辺りを少し記述を変えて、FSOを使った参考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
ここは難しくはないのですが、どうしても記述が面倒になってしまうのは仕方ないように思います。
この辺りを少し記述を変えて、FSOを使った参考VBAを記事補足に掲載しました。
補足
先のVBAでは、Applicationのプロパティ設定を省略しましたが、やはり入れたほうが良いと思います。
再計算の停止については、読み込むファイルの事情（再計算が重い等）によって適宜対応してください。
シートの確認は、存在チェックというより指定名称のシート取得するだけなので、
On Errorを使って簡易に済ませています。
再計算の停止については、読み込むファイルの事情（再計算が重い等）によって適宜対応してください。
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本ノック」の記事
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
38本目：1シートを複数シートに振り分け・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
39本目：数値リストの統合（マージ）・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
40本目：複数ブックの統合41本目：暗算練習アプリ
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
42本目：データベース形式に変換・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
43本目：CSV出力・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
44本目：全テーブル一覧作成・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
45本目：テーブルに列追加・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
46本目：名前定義に使える文字・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
47本目：Window操作・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
新着記事NEW ・・・新着記事一覧を見る
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
累計を求める数式あれこれ｜エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 40本目：複数ブックの統合
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。