[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同一フォルダ内のエクセルシートの合計値の集計』（マクロン）
同一フォルダ内の複数存在するエクセルシートの合計値を出力するマクロを作成したいです。
■仕様
フォルダ内に存在するエクセルファイル名は任意です。
シート１〜シート５まで存在します。
シート１〜シート５には、同一の形式のテーブルが格納されています。
テーブルはA〜E列を使用しており、A列には日付、B〜E列にはそれぞれランダムな数字（空白あり）が格納されています。
フォルダ内に存在するエクセルファイルの
シート１のB1をすべて合計した値を合計値を出力するエクセルファイルのB1に出力
シート１のC1をすべて合計した値を……という形でシート１〜シート５に対して同じく合計値を出力するものを作成したいです。
シート１合計、シート２合計、……といった形で出力を考えています。
各シートの行数は可変的な物のため、集計をする度に最終行までの判定を行う事を想定しています。
例）シート１の入力
A |B|C|D|E 2021/7/19| |2|4|3 2021/7/20|3|1| |2
イメージとしては、フォルダ内に存在する
エクセルファイルの各シートに対して任意のセルの串刺し集計……です。
お力添えいただければと思います。m(_ _)m
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
こんにちわぁ。。。＾＾ ＶＢＡ好きの。。。かぁる〜い、じじぃです。 何ファイルくらいあるのでせうね。。。とファイル名に 何か規則性は？ 拡張子は必ずxlsxだとか、何々が必ず入るとかはいらないとか ちょっときになっただけですので。。。 スルーして頂いてもけっこうですぅ。。。すみませ〜ん でわ m(_ _)m （隠居じーさん） 2021/07/19(月) 11:07
例）
123456_マクロン.xlsx
223454_隠居じーさん.xlsx （敬称略
455434_サンプル太郎.xlsx
（マクロン） 2021/07/19(月) 11:14
早々のさらなる、ご説明、恐縮でございます。 で どのあたりで、お困りで。。。？ m(_ _)m （隠居じーさん） 2021/07/19(月) 11:54
先にコードお渡しした方がよろしければ、その 暫し、御猶予を、その間、他の回答者様から、アドバイスが有れば それが一番です。＾＾； 何分思い込みが激しいので、御気に召さないかもですが、ご構築時、の 際、何かの足しにでもなれば幸甚です。 きょうは、醤油煮込み鳥を作らなければ。。。ｗテスト環境も用意しないと ＾＾；。。。ということで、気長に、あまり、あてにせず、お 待ちくださいませ ← 使い物にならないかも。。。(￣▽￣)。。。(#^.^#) でわでわ m(_ _)m
（隠居じーさん） 2021/07/19(月) 12:40
シート１のB1をすべて合計した値を合計値を出力するエクセルファイルのB1に出力
シート１のB1セルの合計みたいな、セルごとの集計でよいのですか？
シート１のある日付のB列の合計みたいな、日付ごとの集計ではなくて？
失礼しました。
（いっぬ） 2021/07/19(月) 12:41
隠居じーさん様
実際にマクロを自分で組んでから書き込むべきでした。
申し訳ございません
まさしく、こういうことがしたいのですが、ファイル数が増減するためそこで立ち止まってしまった次第です……
（マクロン） 2021/07/19(月) 13:00
＞＞申し訳ございません いえいえ、とんでもございません。 私も大変、勉強になりますので。有難く存じております。 いまから、考えてみますです。。。＾＾；。。。では、また m(_ _)m （隠居じーさん） 2021/07/19(月) 13:40
こんばんは ＾＾
とりあえず、書いてみました。検算してません。その他、文字列だった場合の
エラー処理等、何もない、出来立てのほやほや、バグだらけの可能性大、コー
ドです。一応、最下行、バラバラ。。。対応。。。のつもりです。← 多分
結果、教えて頂けると嬉しいです。さて、美味しい鶏肉でも焚いてきます。
m(_ _)m
Option Explicit
Sub OneInstanceMain()
Dim wb As Workbook
Dim i As Long
Dim j As Long
Dim k As Long
Dim y As Long
Dim x As Long
Dim n As Long
Dim o As Long
Dim gYoMax() As Variant
Dim idx() As Variant
Dim sNm As String
Dim v() As Variant
Dim w() As Variant
Dim fNm As String
Dim fD As String
Dim t As Double
t = Timer
fD = ThisWorkbook.Path & "\"
fNm = Dir(fD & "*.xlsx")
Do Until fNm = ""
Set wb = Workbooks.Open(fD & fNm)
ReDim v(1 To 5)
For i = 1 To wb.Worksheets.Count
With wb.Worksheets(i)
If IsNumeric(Mid(.Name, 4)) Then
x = CLng(Mid(.Name, 4))
Select Case x
Case 1 To 5
v(x) = Intersect(.UsedRange, .Range("B:E")).Value
ReDim Preserve gYoMax(j)
gYoMax(j) = UBound(v(x), 1)
j = j + 1
End Select
End If
End With
Next
ReDim Preserve idx(n)
idx(n) = v
n = n + 1
wb.Close False
fNm = Dir()
DoEvents
Loop
o = Application.Max(gYoMax)
ReDim w(1 To 5, 1 To o, 1 To 4)
For i = LBound(idx) To UBound(idx)
For j = LBound(idx(i)) To UBound(idx(i))
For y = LBound(idx(i)(j), 1) To UBound(idx(i)(j), 1)
For x = LBound(idx(i)(j), 2) To UBound(idx(i)(j), 2)
w(j, y, x) = w(j, y, x) + idx(i)(j)(y, x)
Next
Next
Next
Next
For i = 1 To 5
sNm = "シート" & StrConv(i, vbWide)
If Not Evaluate("=ISREF(" & sNm & "!A1)") Then Sheets.Add.Name = sNm
With Worksheets(sNm)
ReDim v(1 To UBound(w, 2), 1 To UBound(w, 3))
For j = 1 To UBound(w, 2)
For k = 1 To UBound(w, 3)
v(j, k) = w(i, j, k)
Next
Next
.UsedRange.Clear
.Cells(1).Resize(, 5) = Array("A列", "B列", "C列", "D列", "E列")
.Cells(2, 2).Resize(UBound(v, 1), UBound(v, 2)) = v
End With
Next
MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _
Format((Timer - t) - Int(Timer - t), ".000") & " 秒"
End Sub
（隠居じーさん） 2021/07/19(月) 17:21
あらら ｗｗｗ 多分シート名でひっかかりそぉです。当方テスト環境のシート名 は数字です。1，2，3，4，5、そちらで、合わせていただくか、 差し障りなければ実際のシート名、又は規則性が同じのダミーシート名 を、お教えください。 当初からご案内の、全角のシート１〜シート５で良かったですか。 すみません。 （隠居じーさん） 2021/07/19(月) 17:30
こんばんは ＾＾ マクロンさん、すみません ↑ 見なかったことにしてください あわててまして、ブック毎、各、5シートに分けての集計にはなっていません。 多分、総計みたいなので、鳥も焚けましたので、落ち着いて再度点検いたしま すので、今暫し、御猶予を。。。でわでわ。今夜はこれにて、失礼致しますm(__)m （隠居じーさん） 2021/07/19(月) 19:03
（マナ） 2021/07/19(月) 19:34
おはようございます。 マナ さんがご案内ですが なにか、別途ご要望が有りそうな、なさそぉな。。。＾＾； 一応、Ａ列無視版。。。↑ のコード修正しておきました。 串刺しって、こんなにややこしかったかなぁ？ ← 私の考えが ややこしいだけかも。。。(￣▽￣) なにか、もっと、エクセル機能をふんだんに使った、スマートで 高速な、処理が有りそうな気がいたします。でわ、失礼致します 鳥、蒲焼みたいで、おいしかったですよｘ〜(#^.^#) m(_ _)m （隠居じーさん） 2021/07/20(火) 08:02
シート名は別でございますので、こちらで適応するように考え直してみます
マナ様
Aの日付列は基本同一で考えておりますので、とにかく同じシートの同じセルの串刺し集計となります
（マクロン） 2021/07/20(火) 08:35
１）[データ]→[データの取得と変換]→[新しいクエリ]
→[その他のデータソースから] →[空のクエリ]
２）[ホーム]→[クエリ]→[詳細エディター]を開き
下記をコピペ（ソースの行は、実際のファオルダパスに修正）
let
ソース = Folder.Files("C:\****\****\*****"),
#"展開された Attributes" = Table.ExpandRecordColumn(ソース, "Attributes", {"Hidden"}, {"Hidden"}),
小文字テキスト = Table.TransformColumns(#"展開された Attributes",{{"Extension", Text.Lower, type text}}),
フィルターされた行 = Table.SelectRows(小文字テキスト, each [Extension] = ".xlsx" and [Hidden] = false),
追加されたカスタム = Table.AddColumn(フィルターされた行, "カスタム", each Excel.Workbook(File.Contents([Folder Path] & [Name]))),
#"展開された カスタム" = Table.ExpandTableColumn(追加されたカスタム, "カスタム", {"Data", "Item"}, {"Data", "Item"}),
削除された他の列 = Table.SelectColumns(#"展開された カスタム",{"Name", "Item", "Data"}),
追加されたカスタム1 = Table.AddColumn(削除された他の列, "カスタム", each Table.AddIndexColumn([Data],"行番号",1)),
#"展開された カスタム1" = Table.ExpandTableColumn(追加されたカスタム1, "カスタム", {"Column2", "Column3", "Column4", "Column5", "行番号"}, {"Column2", "Column3", "Column4", "Column5", "行番号"}),
選択した列のみをピボット解除しました = Table.Unpivot(#"展開された カスタム1", {"Column2", "Column3", "Column4", "Column5"}, "属性", "値"),
グループ化された行 = Table.Group(選択した列のみをピボット解除しました, {"Item", "行番号", "属性"}, {{"合計", each List.Sum([値]), type number}}),
並べ替えられた行 = Table.Sort(グループ化された行,{{"属性", Order.Ascending}, {"行番号", Order.Ascending}}),
ピボットされた列 = Table.Pivot(並べ替えられた行, List.Distinct(並べ替えられた行[属性]), "属性", "合計", List.Sum),
#"名前が変更された列 " = Table.RenameColumns(ピボットされた列,{{"Item", "シート"}})
in
#"名前が変更された列 "
３）[ホーム]→[閉じる]→[閉じて読み込む] ４）結果イメージ
シート 行番号 Column2 Column3 Column4 Column5 Sheet1 1 4 4 8 Sheet1 2 1 4 6 1 Sheet1 3 6 Sheet2 1 2 1 10 2 Sheet2 2 1 Sheet2 3 2 7 2 3
（集計結果は、隠居じーさん さんのマクロと同じになることを確認しました）
５）テーブルの１列目がシート名なので、目的のシートをフィルターで表示
あえて結果を一つシート（テーブル）に読み込むようにしていますが
シート名毎に、テーブルを分割することも可能です。
（マナ） 2021/07/20(火) 19:07
また、下記にて実装できました事も合わせて報告いたします。
漠然とした形の質問にご回答頂きありがとうございました。
重ねてお礼申し上げます。
集計場所のセルは
行開始位置：C13〜L13
範囲は日付セル（B列）のフォルダ内で最長のものを指定する、という事をしました。
無駄があるかもしれませんが、求めている結果はこれで出力することが可能になりました。
Sub 集計()
Dim f_path As String
Dim data, total
Dim Main_sht As Worksheet '集計メインシート
Set Main_sht = Worksheets("メイン")
Dim sum_sht As Worksheet
Set sum_sht = Worksheets("シート1集計")
'フォルダパスの格納
f_path = Main_sht.Range("A2").Value & "\"
total = 0
f_end = 0
'フォルダ内のシート1から最終行が最長のものを取得
fileName = Dir(f_path & "*.xlsx")
Do Until fileName = ""
'B列（日付列）の最終行を取得
If f_end <= Worksheets("シート1").Cells(Rows.Count, 2).End(xlUp).Row Then
f_end = Worksheets("シート1").Cells(Rows.Count, 2).End(xlUp).Row
End If
fileName = Dir()
Loop
'フォルダ内のシート1串刺し集計
For i = 4 To f_end
For j = 3 To 12
'指定されているフォルダに存在する数分処理を繰り返す
fileName = Dir(f_path & "*.xlsx")
Do Until fileName = ""
data = ExecuteExcel4Macro("'" & f_path & "[" & fileName & "]シート1'!R" & i & "C" & j)
total = total + data
fileName = Dir()
Loop
If 0 < total Then
sum_sht.Cells(i, j) = total
End If
'0クリア
total = 0
Next j
Next i
MsgBox "シート1の集計が完了しました"
End Sub
（マクロン） 2021/07/21(水) 09:59
よかったですね ＾＾ マナ さん、が予定されていた、統合を使った、マクロの 研究、も合わせて、私もとても勉強になりました。 とても、便利そうですね。でわでわ m(_ _)m （隠居じーさん） 2021/07/21(水) 10:38
Sub 集計()
Dim 集計WB As Workbook
Dim メインWS As Worksheet
Dim ws As Worksheet
Dim n As Long
Dim wsn() As String
Dim wb As Workbook
Dim p As String
Dim fn As String
Dim k As Long
Set 集計WB = ThisWorkbook
Set メインWS = 集計WB.Worksheets("メイン")
For Each ws In 集計WB.Worksheets
If ws.Name <> メインWS.Name Then
n = n + 1
ReDim Preserve wsn(1 To n)
wsn(n) = ws.Name
ws.Range("A1", ws.UsedRange).Offset(3, 2).ClearContents
End If
Next
p = 集計WB.Sheets("メイン").Range("A2").Value & "\"
fn = Dir(p & "*.xlsx")
Do While fn <> ""
Set wb = Workbooks.Open(p & fn)
For k = 1 To n
With wb.Sheets(wsn(k))
.Range("A1", .UsedRange).Offset(3, 2).Copy
End With
集計WB.Sheets(wsn(k)).Range("C4").PasteSpecial xlPasteValues, xlAdd
Next
wb.Close False
fn = Dir()
Loop
MsgBox "集計が完了しました"
End Sub
（マナ） 2021/07/21(水) 20:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.