[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フォルダー内の全てのファイルにある同一名シートの表を集計する』(太陽)
あるフォルダー内の全てのファイルにある同一名シートの表を集計したいのですが、エクセルの標準機能では手間がかかりそうです。マクロで簡単にできませんか?
例えば、フォルダーC:\Users\name\excelに30個のエクセルファイル(.xlsx)があります。それぞれのファイルにはabcという名のシートが必ずあります。そのabcシートには同じ範囲(B2:M13)で表が存在します。この表にある値(整数値のみです)を収集して合計値の表を作りたいのです。出力ファイルは、一個上のフォルダーにすでに存在するC:\Users\name\all.xlsxを使います。このファイルの先頭に新しいシートsumを作成し、同じ範囲(B2:M13)に合計値の表を作るという流れです。
ちなみにB列と2行には表のラベルがついています。ラベルも含めて集計できれば良いですが、これは手作業でも簡単に追加・削除できるので、外して集計するマクロも大丈夫です(その場合はC3:M13ということになります)。
表は合計値のみでよいです。もしも可能であれば、値だけでなく各ファイルの表データにリンクしているとありがたいですね。元ファイルが変更された場合、合計値も自動的に更新されるので。これはちょっと難易度が高そうな気がしますが・・・。
できそうな方お願いします。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
30個なら少し頑張れば、統合が使えます。
マクロを考えるより手っ取り早いです。
>各ファイルの表データにリンクしているとありがたいですね。
これも可能です。(たぶん)
(マナ) 2019/08/05(月) 18:55
(マナ) 2019/08/05(月) 19:08
(マナ) 2019/08/05(月) 19:14
>C:\Users\name\excelに30個のエクセルファイル(.xlsx)があります。 本当にこんな階層にフォルダがあるのかな? (seiya) 2019/08/05(月) 19:42
30個なら少し頑張れば、統合が使えます 30個は一例です。これが10つ分あります。マクロなしでやると、一つずつファイルを開いて追加していくのだと推測しますので、結構たいへんかなと。
本当にこんな階層にフォルダがあるのかな? ありません。適当です。
マナさんのリンクも見てみたいと思いますが、質問の内容を直接できる方がいたら大感謝です。結構難しいのでしょうか?すみません。
(太陽) 2019/08/05(月) 22:59
>ありません。適当です。 適当すぎるよ。 その階層だと通常無理だからコードも書きたくなかった。 30ファイルのリンクねーーー。難しくはないけど、もう少し現実味のあるフォルダにしてほしいね。 (seiya) 2019/08/05(月) 23:10
もう少し現実味のあるフォルダにしてほしいね。
素人の質問ですみませんが、マクロでできない階層というのがあるのですか?知りませんでした。具体的にはどういう制限があるのですか?少し興味があります。個人的にはcの直下でも、デスクトップでもパスはなんでもよいと思ってました。例えば、存在するフォルダで個人情報が入らないとなると、こんなフォルダがあります。
C:\Users\Public\Documents
これでも無理なのでしょうか?こちらとしては、フォルダの場所にこだわりはないので、できる階層を適宜指定してもらって構わないのですが・・・。
(太陽) 2019/08/06(火) 17:32
通常C:\Usersにはアクセス権の問題があるはずです。 マクロ以前の問題で、本当にそんなフォルダにファイルが保存してあって、そのファイルが 読み取り専用以外で開けて再保存ができるなら、アクセス権が事前になされているのでしょうが。
試してみればわかると思いますよ? (seiya) 2019/08/06(火) 19:07
(太陽) 2019/08/06(火) 23:52
問題ないということなら、当方仮フォルダで検証済み。 30ファイルにリンクする。ということなので再計算の時間がかかると思います。
Sub test() Dim myDir As String, wn As String, fn As String, ws As Worksheet Dim i As Long, ii As Long, temp As String myDir = "C:\Users\name\": wn = "abc" If Dir(myDir & "all.xlsx", 0) = "" Then MsgBox "該当ブック無し", vbCritical, myDir & "All.xlsx" Exit Sub End If If Dir(myDir & "Excel", 16) = "" Then MsgBox "該当フォルダ無し", vbCritical, myDir & "Excel" Exit Sub End If fn = Dir(myDir & "Excel\*.xlsx") If fn = "" Then MsgBox "該当ファイル無し": Exit Sub Application.ScreenUpdating = False With Workbooks.Open(myDir & "All.xlsx") On Error Resume Next Set ws = .Sheets("sum") On Error GoTo 0 If ws Is Nothing Then .Sheets.Add(.Sheets(1)).Name = "Sum" Application.ReferenceStyle = xlR1C1 Application.Calculation = xlCalculationManual myDir = myDir & "Excel\" With Sheets("Sum") .Cells.ClearContents Do While fn <> "" .[b2:b13,c2:m2].FormulaR1C1 = _ Chr(2) & "'" & myDir & "[" & fn & "]" & wn & "'!rc" For i = 3 To 13 For ii = 3 To 13 temp = .Cells(i, ii).FormulaR1C1 temp = temp & IIf(temp = "", Chr(2), "+") & "'" & myDir & "[" & fn & "]" & wn & "'!rc" .Cells(i, ii).FormulaR1C1 = temp Next Next fn = Dir Loop .Cells.Replace Chr(2), "=", 2 End With Application.Calculation = xlCalculationAutomatic Application.ReferenceStyle = xlA1 .Close True End With End Sub
(seiya) 2019/08/07(水) 11:50
Sub test2() Dim p As String Dim wbn As String Dim f As String
p = ThisWorkbook.Path & "\excel\" wbn = Dir(p & "*.xlsx")
Do While wbn <> "" f = f & "+'" & p & "[" & wbn & "]abc'!C3" wbn = Dir() Loop
With Worksheets.Add Range("C3:M13").Formula = "= " & f End With
End Sub
(マナ) 2019/08/07(水) 19:47 差し替えました。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.