エクセルの学校：全文検索：Hyper Estraier： ExecuteExcel4Macro　閉じた｜開いて

Results of 1 - 1 of about 71 for ExecuteExcel4Macro　閉じた｜開いて｜開かず (0.012 sec.)

executeexcel4macro (140), 閉じた (628), 開いて (4901), 開かず (263)

[[20210719102057]]: #score: 14120; @digest: 2e83498fb24c795ed81b885152e8d641; @id: 88414; @mdate: 2021-07-21T11:14:34Z; @size: 14334; @type: text/plain; #keywords: 計wb (42032), タム (11876), 列", (9871), ム", (9532), カス (7215), 隠居 (6537), 串刺 (6020), table (5412), 属性 (5047), total (4911), ダ内 (4577), ト5 (4564), メイ (4474), 居じ (4186), じー (4038), ロン (3575), 展開 (3481), 集計 (3411), ト1 (3071), 計値 (2986), idx (2936), スタ (2647), 2021 (2392), …… (2386), filename (2230), シー (2076), ーさ (2027), ォル (2004), 行番 (1885), ルダ (1860), （隠 (1858), 出力 (1790); 『同一フォルダ内のエクセルシートの合計値の集計』（マクロン）
同一フォルダ内の複数存在するエクセルシートの合計値を出力するマクロを作成したいです。 ■仕様フォルダ内に存在するエクセルファイル名は任意です。シート1〜シート5まで存在します。シート1〜シート5には、同一の形式のテーブルが格納されています。テーブルはA〜E列を使用しており、A列には日付、B〜E列にはそれぞれランダムな数字（空白あり）が格納されています。フォルダ内に存在するエクセルファイルのシート1のB1をすべて合計した値を合計値を出力するエクセルファイルのB1に出力シート1のC1をすべて合計した値を……という形でシート1〜シート5に対して同じく合計値を出力するものを作成したいです。シート1合計、シート2合計、……といった形で出力を考えています。各シートの行数は可変的な物のため、集計をする度に最終行までの判定を行う事を想定しています。例）シート1の入力 A |B|C|D|E 2021/7/19| |2|4|3 2021/7/20|3|1| |2 イメージとしては、フォルダ内に存在するエクセルファイルの各シートに対して任意のセルの串刺し集計……です。お力添えいただければと思います。m(_ _)m ＜使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- こんにちわぁ。。。^^ VBA好きの。。。かぁる〜い、じじぃです。何ファイルくらいあるのでせうね。。。とファイル名に何か規則性は? 拡張子は必ずxlsxだとか、何々が必ず入るとかはいらないとかちょっときになっただけですので。。。スルーして頂いてもけっこうですぅ。。。すみませ〜んでわ m(_ _)m （隠居じーさん） 2021/07/19(月) 11:07 ---- 隠居じーさん様ご返信ありがとうございますフォルダ内に存在するファイルは10程度です。ファイルの命名規則は数字_氏名.xlsxとなっております。数字の桁数は6桁、頭の数字が1〜5で決まっております。例） 123456_マクロン.xlsx 223454_隠居じーさん.xlsx （敬称略 455434_サンプル太郎.xlsx （マクロン） 2021/07/19(月) 11:14 ---- 追記させていただきます。現状は10程度ですが、今後増減する可能性があるためフォルダ内のすべてを……という記載をさせていただきました。（マクロン） 2021/07/19(月) 11:16 ---- 早々のさらなる、ご説明、恐縮でございます。でどのあたりで、お困りで。。。? m(_ _)m （隠居じーさん） 2021/07/19(月) 11:54 ---- 先にコードお渡しした方がよろしければ、その暫し、御猶予を、その間、他の回答者様から、アドバイスが有ればそれが一番です。^^; 何分思い込みが激しいので、御気に召さないかもですが、ご構築時、の際、何かの足しにでもなれば幸甚です。きょうは、醤油煮込み鳥を作らなければ。。。wテスト環境も用意しないと ^^;。。。ということで、気長に、あまり、あてにせず、お待ちくださいませ ← 使い物にならないかも。。。(￣▽￣)。。。(#^.^#) でわでわ m(_ _)m （隠居じーさん） 2021/07/19(月) 12:40 ---- 横から失礼します。ちょい気になったので。 > シート1のB1をすべて合計した値を合計値を出力するエクセルファイルのB1に出力シート1のB1セルの合計みたいな、セルごとの集計でよいのですか? シート1のある日付のB列の合計みたいな、日付ごとの集計ではなくて? 失礼しました。（いっぬ） 2021/07/19(月) 12:41 ---- いっぬ様セル毎の集計となります。隠居じーさん様実際にマクロを自分で組んでから書き込むべきでした。申し訳ございません https://whiteleia.com/%e3%82%a8%e3%82%af%e3%82%bb%e3%83%ab-%e9%9b%86%e8%a8%88-%e3%82%b7%e3%83%bc%e3%83%88/ まさしく、こういうことがしたいのですが、ファイル数が増減するためそこで立ち止まってしまった次第です…… （マクロン） 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 ---- あらら www 多分シート名でひっかかりそぉです。当方テスト環境のシート名は数字です。1,2,3,4,5、そちらで、合わせていただくか、差し障りなければ実際のシート名、又は規則性が同じのダミーシート名を、お教えください。当初からご案内の、全角のシート1〜シート5で良かったですか。すみません。（隠居じーさん） 2021/07/19(月) 17:30 ---- こんばんは ^^ マクロンさん、すみません ↑ 見なかったことにしてくださいあわててまして、ブック毎、各、5シートに分けての集計にはなっていません。多分、総計みたいなので、鳥も焚けましたので、落ち着いて再度点検いたしますので、今暫し、御猶予を。。。でわでわ。今夜はこれにて、失礼致しますm(__)m （隠居じーさん） 2021/07/19(月) 19:03 ---- A洌の日付は、各ブックで異なっていても、気にしないで、とにかく同じセル番地を集計するということでしょうか。それとも、すべてのブックでA洌は同じなのでしょうか。（マナ） 2021/07/19(月) 19:34 ---- おはようございます。マナさんがご案内ですがなにか、別途ご要望が有りそうな、なさそぉな。。。^^; 一応、A列無視版。。。↑ のコード修正しておきました。串刺しって、こんなにややこしかったかなぁ? ← 私の考えがややこしいだけかも。。。(￣▽￣) なにか、もっと、エクセル機能をふんだんに使った、スマートで高速な、処理が有りそうな気がいたします。でわ、失礼致します鳥、蒲焼みたいで、おいしかったですよx〜(#^.^#) m(_ _)m （隠居じーさん） 2021/07/20(火) 08:02 ---- 隠居じーさん様ありがとうございます。この後、自分でも試してみます統合昨日等があることを昨日調べて知りました。結局、ファイル名とファイル数がこていされていないため、難しい……となっていましたシート名は別でございますので、こちらで適応するように考え直してみますマナ様 Aの日付列は基本同一で考えておりますので、とにかく同じシートの同じセルの串刺し集計となります（マクロン） 2021/07/20(火) 08:35 ---- ＞とにかく同じシートの同じセルの串刺し集計となります貴方が提示した URL を参照にして出来ませんか。（maku） 2021/07/20(火) 15:36 ---- 解決だと思いますので別案です。「統合」を利用したマクロを書こうとしましたが、途中で面倒になって方針変更。 2016以降標準で使えるようになったPower Queryです。 1）[データ]→[データの取得と変換]→[新しいクエリ] →[その他のデータソースから] →[空のクエリ] 2）[ホーム]→[クエリ]→[詳細エディター]を開き下記をコピペ（ソースの行は、実際のファオルダパスに修正） 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 #"名前が変更された列 " 3）[ホーム]→[閉じる]→[閉じて読み込む] 4）結果イメージシート行番号 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 （集計結果は、隠居じーさんさんのマクロと同じになることを確認しました） 5）テーブルの1列目がシート名なので、目的のシートをフィルターで表示あえて結果を一つシート（テーブル）に読み込むようにしていますがシート名毎に、テーブルを分割することも可能です。（マナ） 2021/07/20(火) 19:07 ---- 皆様方、ご教示いただきありがとうございます。 Power Queryは触ったことがなかったので、調べながら実装してみたいと思います。また、下記にて実装できました事も合わせて報告いたします。漠然とした形の質問にご回答頂きありがとうございました。重ねてお礼申し上げます。集計場所のセルは行開始位置: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 ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/202107/20210719102057.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ