[[20190805173433]] 『フォルダー内の全てのファイルにある同一名シート』(太陽) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『フォルダー内の全てのファイルにある同一名シートの表を集計する』(太陽)

あるフォルダー内の全てのファイルにある同一名シートの表を集計したいのですが、エクセルの標準機能では手間がかかりそうです。マクロで簡単にできませんか?

例えば、フォルダー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


ありました。これです。
[[20190723200156]] 『複数ブックのSUM』(AI)

(マナ) 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

seiyaさん、返信ありがとうございました。

もう少し現実味のあるフォルダにしてほしいね。

素人の質問ですみませんが、マクロでできない階層というのがあるのですか?知りませんでした。具体的にはどういう制限があるのですか?少し興味があります。個人的にはcの直下でも、デスクトップでもパスはなんでもよいと思ってました。例えば、存在するフォルダで個人情報が入らないとなると、こんなフォルダがあります。
C:\Users\Public\Documents
これでも無理なのでしょうか?こちらとしては、フォルダの場所にこだわりはないので、できる階層を適宜指定してもらって構わないのですが・・・。
(太陽) 2019/08/06(火) 17:32


 通常C:\Usersにはアクセス権の問題があるはずです。
 マクロ以前の問題で、本当にそんなフォルダにファイルが保存してあって、そのファイルが
 読み取り専用以外で開けて再保存ができるなら、アクセス権が事前になされているのでしょうが。

 試してみればわかると思いますよ?
(seiya) 2019/08/06(火) 19:07

組織のPCなので、こういう設定です。また、admin権限があるので、全く問題はありませんが・・・。

(太陽) 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


マクロブックと同じ階層にexcelフォルダがあり、その中のファイルが対象。
all.xlsxを最前面にして実行してください。
シート名とか見出しは手作業で。あるいは、ご自身で修正してください。

 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.