指定フォルダからファイルを全て開き、先月分の集計をする方法（VBA）が分かりません

１）指定フォルダからファイルを全て開く
２）開いたファイルのシート名を集計用シートに貼り付け
３）先月分の数字を集計し、２）で張り付けたシート名と同じ列に貼り付け
４）指定フォルダ内のファイル全てに対して２）３）を繰り返す

１）は出来たのですが、２）３）４）がなかなか出来ずに躓いております。
どなたかご教示いただけますと幸いです。よろしくお願いいたします。

※１）は下記VBAを使用したいと思っております。
　できれば、このVBAの中に２）～４）を組み込めるといいのですが…
（フォルダの指定が簡単にできるため）

ーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 指定したフォルダ内のファイルを開く ()

Dim Filename As String
Dim IsBookOpen As Boolean
Dim OpenBook As Workbook
Dim myFolder As Variant

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> 0 Then
myFolder = .SelectedItems(1)
End If
End With
With CreateObject("WScript.Shell")
.CurrentDirectory = myFolder
End With
Filename = Dir("*.xlsx")
Do While Filename <> ""
If Filename <> ThisWorkbook.Name Then
IsBookOpen = False
For Each OpenBook In Workbooks
If OpenBook.Name = Filename Then
IsBookOpen = True
Exit For
End If
Next
If IsBookOpen = False Then
Workbooks.Open (Filename), UpdateLinks:=1
End If
End If
Filename = Dir()
Loop
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーー

No.1 ベストアンサー 回答者： fujillin 回答日時： 2022/02/13 20:29

こんばんは

＞開いたファイルのシート名を～
シート構成がどうなっているのか不明ですが、添付図だとブック内に1シートしか存在していないようなので、ブックを開いた時のシートで良いものと解釈しました。

また、ご提示のコードでは「既に開いているファイルか」をチェックしているようですが、状態が一定ではないようですので、以下では、チェックを省いてエクセルの別スレッドで開いてしまう方法にしてあります。
さらに、ThisWorkbookは.xlsmだと想像しますが、処理対象は.xlsxに限定されているようですので、こちらのチェックも省いています。
（.xlsmも対象に含める場合には、必要になるかも知れません）

＞できれば、このVBAの中に２）～４）を組み込めるといいのですが
構成はそのままにしてありますが、不要な部分を削除するとあまり元のコードは残らない状態にはなってしまいましたが、以下ご参考までに。

※ 各ブックを順に開いて閉じることになるので、処理にはそれなりの時間がかかります。
（まずは、ブック数の少ないテストフォルダでテストしてください）

Sub Q12804215()
Dim OE, wb
Dim dRange As Range, r As Range
Dim myFolder As String, Filename As String
Dim d1 As String, d2 As String

With Application.FileDialog(msoFileDialogFolderPicker)
If Not .Show Then Exit Sub
myFolder = .SelectedItems(1) & "\"
End With

Set dRange = ActiveSheet.Range("B1:B3")
Set OE = CreateObject("Excel.Application")
d1 = ">" & CStr(DateSerial(Year(Date), Month(Date) - 1, 0))
d2 = "<" & CStr(DateSerial(Year(Date), Month(Date), 1))

Filename = Dir(myFolder & "*.xlsx")
Do While Filename <> ""
Set wb = OE.Workbooks.Open(myFolder & Filename, 3, True)
Set r = wb.ActiveSheet.Columns(1)
dRange(1).Value = r.Worksheet.Name
dRange(2).Value = OE.WorksheetFunction.SumIfs(r.Offset(, 1), r, d1, r, d2)
dRange(3).Value = OE.WorksheetFunction.SumIfs(r.Offset(, 2), r, d1, r, d2)
wb.Close False

Set dRange = dRange.Offset(, 1)
Filename = Dir()
Loop

OE.Quit
MsgBox "終了しました"
End Sub

この回答へのお礼

早速にご回答いただいたにも関わらず、お礼が遅くなり申し訳ございません。先ほど、試したところ私の希望通りにアウトプット出来ておりました！ありがとうございます。
私の知らないコードもあり、勉強不足を痛感しております。
意味も掴めるようになってから仕事に活用したいと思います。

失礼ながら、再度質問なのですが、
ここまで書けるようになるのにどれくらいの年月がかかったのでしょうか？勉強法もご教示いただけると幸いです。。。

お礼日時：2022/02/15 20:29