[[20120914092942]]　『複数ファイルの集計について』（じゅん）　ページの最後に飛ぶ

『複数ファイルの集計について』（じゅん）

お世話になります。

同一フォルダにある複数のエクセルファイルの
Sheet1のみの集計を自動的で行いたいと思っています。

　・1ファイル最大50行まで数値が記入されています。
　・合計したいのは、3列目のみです。
　・ファイル名は、特にきまりはありません。
　　フォルダにあるエクセルファイルすべてです。

どのような方法でも構いませんので、ご教授ください。
よろしくお願いいたします。

エクセルのバージョン
　Excel2007
OSのバージョン
　WindowsXP

 どのように集計したいのかがわからないので、とりあず合計値を表示するのみ。

 Sub Sample()
    Dim myPath As String
    Dim myName As String
    Dim n As Long
    Dim z As Long
    Dim t As Long

    Application.ScreenUpdating = False

    myPath = "c:\Test\" 'フォルダ名は実際のものに

    myName = Dir(myPath & "*.xls")

    Do While myName <> ""
        Workbooks.Open myPath & myName
        With ActiveWorkbook.Sheets(1)
            z = WorksheetFunction.Min(50, .Range("C" & .Rows.Count).End(xlUp).Row)
            n = WorksheetFunction.Sum(.Range("C1").Resize(z))
            ActiveWorkbook.Close False
            t = t + n
            myName = Dir()
        End With
    Loop

    Application.ScreenUpdating = True
    MsgBox "合計値は " & t & " でした"

 End Sub

 (ぶらっと)

 ↑　でも、ほんとは　Ｃ列の各行の値を串刺し集計のような感じで集計したいのかな？
 そのあたりの、できあがりのイメージをきちんと説明すれば、皆さんから回答があると思うよ。

 (ぶらっと)

ぶらっとさん、早速の回答ありがとうございます。

出来上がりのイメージは、ぶらっとさんのおっしゃる通りです。

ちなみに、上記プログラムは、新規エクセルのマクロに記載すればよろしいのでしょうか？
お手数ですが、よろしくお願いいたします。

実際のイメージとしては、

a|b|c
1|2|3
4|3|7

a|b|c
3|1|4
4|5|9

上記のファイルたちの、C列のみを足していって
最終ファイルのC列の末か、別ファイルに出力したいと思っています。

よろしくお願いいたします。

 >ちなみに、上記プログラムは、新規エクセルのマクロに記載すればよろしいのでしょうか？

 うん。以下のSample2,Sample3も含めて新規ブック。
 で、以下は、集計すべきブックがある、そのフォルダに、マクロブックを作って。
 集計結果はマクロブックのSheet1のC列に表示。

 Sample2はエクセルの、形式を指定して貼り付け（加算）機能を利用。
 Sample3は、いかにもＶＢＡらしい（？）コードかな？
 いずれでも。

 Sub Sample2()
    Dim myPath As String
    Dim myName As String
    Dim shTo As Worksheet

    Application.ScreenUpdating = False

    myPath = ThisWorkbook.Path & "\"            'マクロブックと同じフォルダ
    Set shTo = ThisWorkbook.Sheets("Sheet1")        '集計シート名
    shTo.Columns("C").ClearContents             '集計前にクリア

    myName = Dir(myPath & "*.xls")

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then     '自ブックは計算対象外

            With Workbooks.Open(myPath & myName).Sheets(1)
                '形式を指定して貼り付け：加算
                .Columns("C").Copy
                shTo.Range("C1").PasteSpecial Paste:=xlPasteAll, _
                    Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
                .Parent.Close False
            End With

        End If

        myName = Dir()

    Loop

    Application.ScreenUpdating = True
    MsgBox "串刺し集計完了です"

 End Sub

 Sub Sample3()
    Dim myPath As String
    Dim myName As String
    Dim shTo As Worksheet
    Dim v As Variant
    Dim c As Range
    Dim z As Long
    Dim x As Long

    Application.ScreenUpdating = False

    myPath = ThisWorkbook.Path & "\"            'マクロブックと同じフォルダ
    Set shTo = ThisWorkbook.Sheets("Sheet1")        '集計シート名
    shTo.Columns("C").ClearContents             '集計前にクリア
    ReDim v(1 To shTo.Rows.Count, 1 To 1)       '集計用配列

    myName = Dir(myPath & "*.xls")

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then     '自ブックは計算対象外
            z = 0
            With Workbooks.Open(myPath & myName).Sheets(1)
                For Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
                    z = z + 1
                    v(z, 1) = v(z, 1) + c.Value
                Next
                x = WorksheetFunction.Max(z, x)
                .Parent.Close False
            End With

        End If

        myName = Dir()

    Loop

    shTo.Range("C1").Resize(x).Value = v

    Application.ScreenUpdating = True
    MsgBox "串刺し集計完了です"

 End Sub

 (ぶらっと)

ぶらっとさん、ありがとうございます。

さっそく試してみます。

(じゅん)

ぶらっとさん、できました。
sample3を使わせていただこうかと思います。

そこで、２つほど教えていただきたいのですが、
１つ目
　C列の総合計を最後に出力したい。

２つ目
　表示形式で、小数点３桁まで表示している
　数値の計算方法

　C列の実際の数値は、1.2345　小数点４桁
　C列に表示されている数値は、1.234　小数点３桁
　総合計でほしい数値は、小数点３桁

お手数おかけしますが、よろしくお願いします。(じゅん)

 元の値ではなくセルに表示されている値で計算するということだね？
 集計用のC列にも表示書式設定はしておいてね。
 １ヶ所変更、１ヶ所追加。

 Sub Sample4()
    Dim myPath As String
    Dim myName As String
    Dim shTo As Worksheet
    Dim v As Variant
    Dim c As Range
    Dim z As Long
    Dim x As Long

    Application.ScreenUpdating = False

    myPath = ThisWorkbook.Path & "\"            'マクロブックと同じフォルダ
    Set shTo = ThisWorkbook.Sheets("Sheet1")        '集計シート名
    shTo.Columns("C").ClearContents             '集計前にクリア
    ReDim v(1 To shTo.Rows.Count, 1 To 1)       '集計用配列

    myName = Dir(myPath & "*.xls")

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then     '自ブックは計算対象外
            z = 0
            With Workbooks.Open(myPath & myName).Sheets(1)
                For Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
                    z = z + 1
                    v(z, 1) = v(z, 1) + CDbl(c.Text)  '★変更
                Next
                x = WorksheetFunction.Max(z, x)
                .Parent.Close False
            End With

        End If

        myName = Dir()

    Loop

    shTo.Range("C1").Resize(x).Value = v
    shTo.Range("C" & x + 1).FormulaR1C1 = "=SUM(R1C:R[-1]C)"    '★追加

    Application.ScreenUpdating = True
    MsgBox "串刺し集計完了です"

 End Sub

 (ぶらっと)

ぶらっとさん、ありがとうございます。

実行してみたら、v(z, 1) = v(z, 1) + CDbl(c.Text)=＜型が一致しません＞
といわれてしまいました。

何が原因なのでしょうか？

すいませんがよろしくお願いいたします。

(じゅん)

 対象のセルには、どんな表示がされている？
 123.567 とか 123.567- とか　そういった表示なら問題はないけど、123.567円　といった表示書式だと
 エラーになる。

 追記）集計元のブックのC列には、どんな表示書式が設定されている？

 (ぶらっと)

 ↑　思い直して。小数点以下４桁の実際の数値に対して、表示書式で小数点以下を３ケタにしてあるということをベースに。
　（つまり、表示上は小数点以下第４位が四捨五入されているとして）

 テスト確認はしていないので、バグあればご容赦。

 Sub Sample5()
    Dim myPath As String
    Dim myName As String
    Dim shTo As Worksheet
    Dim v As Variant
    Dim c As Range
    Dim z As Long
    Dim x As Long

    Application.ScreenUpdating = False

    myPath = ThisWorkbook.Path & "\"            'マクロブックと同じフォルダ
    Set shTo = ThisWorkbook.Sheets("Sheet1")        '集計シート名
    shTo.Columns("C").ClearContents             '集計前にクリア
    ReDim v(1 To shTo.Rows.Count, 1 To 1)       '集計用配列

    myName = Dir(myPath & "*.xls")

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then     '自ブックは計算対象外
            z = 0
            With Workbooks.Open(myPath & myName).Sheets(1)
                For Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
                    z = z + 1
                    v(z, 1) = v(z, 1) + WorksheetFunction.Round(c.Value, 3) '★変更
                Next
                x = WorksheetFunction.Max(z, x)
                .Parent.Close False
            End With

        End If

        myName = Dir()

    Loop

    shTo.Range("C1").Resize(x).Value = v
    shTo.Range("C" & x + 1).FormulaR1C1 = "=SUM(R1C:R[-1]C)"

    Application.ScreenUpdating = True
    MsgBox "串刺し集計完了です"

 End Sub

 (ぶらっと)

ぶらっとさん、ありがとうございます。
無事、できました。

質問なのですが、列を変更する場合は、
Cを変更すればよいのでしょうか？

ちなみに、１つのファイルに、複数シート
ある場合も、同じような方法でできるのでしょうか？

質問ばかりですいません。

(じゅん)

 複数シート対応版。あわせて集計列は先頭の　    
 Const SUMCOL As String = "C"        '★集計列
 ここで指定。

 Sub Sample6()

    Const SUMCOL As String = "C"        '★集計列

    Dim myPath As String
    Dim myName As String
    Dim shTo As Worksheet
    Dim v As Variant
    Dim c As Range
    Dim z As Long
    Dim x As Long
    Dim sh As Worksheet

    Application.ScreenUpdating = False

    myPath = ThisWorkbook.Path & "\"            'マクロブックと同じフォルダ
    Set shTo = ThisWorkbook.Sheets("Sheet1")    '集計シート名
    shTo.Columns(SUMCOL).ClearContents          '集計前にクリア
    ReDim v(1 To shTo.Rows.Count, 1 To 1)       '集計用配列

    myName = Dir(myPath & "*.xls")

    Do While myName <> ""

        If myName <> ThisWorkbook.Name Then     '自ブックは計算対象外
            With Workbooks.Open(myPath & myName)
                For Each sh In .Worksheets
                    z = 0
                    For Each c In sh.Range(SUMCOL & 1, sh.Range(SUMCOL & sh.Rows.Count).End(xlUp))
                        z = z + 1
                        v(z, 1) = v(z, 1) + WorksheetFunction.Round(c.Value, 3)
                    Next
                    x = WorksheetFunction.Max(z, x)
                Next
                .Close False
            End With

        End If

        myName = Dir()

    Loop

    shTo.Range(SUMCOL & 1).Resize(x).Value = v
    shTo.Range(SUMCOL & x + 1).FormulaR1C1 = "=SUM(R1C:R[-1]C)"

    Application.ScreenUpdating = True
    MsgBox "串刺し集計完了です"

 End Sub

 (ぶらっと)

 ↑　追記で

 複数シート対応版はSample6のとおりだけど、当面、何枚シートがあろうと最初のシートだけ。
 かつ、列は C ではなく 別の列　ということなら、Sample5 の コードの中の "C　なんたら　というところを
 別の列記号にして使ってね。

 (ぶらっと)

ぶらっとさん、遅くなりました。
ありがとうございました。

ちなみに、こんなことはできるのでしょうか？
複数シートを使用しかつ、集計用シートは別に存在しない場合、
最終シートのある文字列がE列のx行目に存在したら、
その隣（F列のx行目）に合計値を出力する。

1ブックですべてを完了したくなってしまいまして、、、。

何度もすいませんが、よろしくお願いします。

(じゅん)

↑大事なこと忘れていました。
エクセルのブックは、セルが統合されています。
B,CD,EF,GHIって感じです。
合計値は、GHIです。
(じゅん)

 これまでの要件は、「複数ブック」を取り出して、それぞれのＣ列を串刺し集計。
 で、最初は、各ブック、シートが１枚だけ。次の希望として、その各ブックが「複数シート」なら
 それらすべてのシートも串刺し集計対象。

 いずれにしても、「複数ブック」のＣ列の値の集計を「どこかに」表示する。
 こういうことだったね。
 で、アップしたコードはいずれも、「マクロが書かれているブック」のSheet1を、その「どこか」にしている。

 で、今回の要望は、その「どこか」が、マクロブックのSheet1ではなく、抽出した【最後のブック】（どのブックかはわからない）の
 【最後のシート】の　Ｆ列に表示したいの？

 それとも、【各ブックごとに】、その最後のシートのＦ列に、【そのブックだけの】串刺し集計を表示したいの？
 （もし、こうなら、マクロではなく、シート上の串刺し集計の関数式で集計できるんだけどね？）

 >1ブックですべてを完了したくなってしまいまして、、、。

 この意味というか、意図がわからないなぁ。今でも、マクロブック１つで完了してるんだけど？

 セル結合の件は了解だけど、そちらのイメージを具体的に教えてくれる？

 (ぶらっと)

ぶらっとさん、すいません。
ブックは１つしかありません。
そのブックの中に、複数シートがあります。
そのブックの最終シートGHI列に合計を出力したいと思っています。

出力する場所は、文字列がEF列のx行目に存在したら、
その隣（GHI列のx行目）に合計値を出力する。

上記のようなことなんですが、どうでしょうか？
(じゅん)

1ブックですべてを完了したくなってしまいまして、、、。

の意味は、複数ブックを扱わず、1ブックに複数シート
で運用するという意味です。

紛らわしい言葉ですいません。
(じゅん)

 要件はわかったけど、それは、最初からそういう要件だったのかな？
 最初の質問は、１つのフォルダにいくつもブックがあって、それらを集計ということだったけど。
 それはそれとして、また別の新しい要件として今回の仕様でコードを作りたいということならわかるけど。

 まぁ、さておき。

 最初にアップされたレイアウトはA,B,C列があって、その内、A,B列は無視。C列のみを串刺し集計して
 「どこかの」C列に表示　ということだったね。

 今回の説明では、

 >そのブックの最終シートGHI列に合計を出力したいと思っています。  
 >出力する場所は、文字列がEF列のx行目に存在したら、 
 >その隣（GHI列のx行目）に合計値を出力する。

 A,B,C が登場せず、E,F,G,H,I が登場？
 具体的な各シートのレイアウトと、最終シートの集計列のレイアウトと集計条件について
 もう少し明確に説明してくれないかな？

 (ぶらっと)

各シートのレイアウト
Aは空白

B|CD |EF |GHI
1|0.211|0.311|0.066
2|0.211|0.311|0.066
・
・
・

最終シートのレイアウト
Aは空白

B |CD |EF |GHI
101|0.211|0.311|0.066
102|0.211|0.311|0.066

   |     |合計 |　　 ←それまでの合計を出力

B:はNo
CDとEFは数値
GHIは、CDとEFをかけたもの
各シート同一フォーマットです。
各シートは最大No50まで
EFにある文字列が存在した場合、GHIに合計を出力

上記のようなイメージです。
お手数ですが、よろしくお願いします。
(じゅん)

 それでは「そのブック」の標準モジュールに。
 最後のシートの「合計欄」の数値は空白の状態で実行。

 Sub Sample7()
    Dim shTo As Worksheet
    Dim sh As Worksheet
    Dim tot As Double
    Dim c As Range
    Dim z As Variant

    Application.ScreenUpdating = False

    Set shTo = ThisWorkbook.Worksheets(Worksheets.Count)        '最後のシート

    For Each sh In ThisWorkbook.Worksheets
        For Each c In sh.Range("G1", sh.Range("G1").End(xlDown))
            tot = tot + WorksheetFunction.Round(c.Value, 3)
        Next
    Next

    With shTo
        z = Application.Match("合計", .Columns("E"), 0)
        If IsNumeric(z) Then
            .Range("G" & z).Value = tot
        Else
            MsgBox "合計欄がありません"
        End If
        .Select
    End With

    Application.ScreenUpdating = True
    MsgBox "集計完了です"

 End Sub

 (ぶらっと)

 横から失礼します。(usamiyu)と申します。
(ぶらっと)さんに質問したくて、こちらに立ち入ってしまいました。
(じゅん)さん、恐縮です。ご無礼いたします。

 TO ぶらっとさん
相変わらず、勉強させていただいています。ありがとうございます。
１点教えてください。
Sample5ではFor Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
と、Ｃ列のﾃﾞｰﾀの最終行からﾃﾞｰﾀのある一番上の行を指定している（？ということですか）のを、

 Sample7ではFor Each c In sh.Range("G1", sh.Range("G1").End(xlDown))
とＧ１のﾃﾞｰﾀからその列の最終ﾃﾞｰﾀを指定するように変えているのはなぜですか？
最終行が「合計」でその一つ前の行が空白だから、空白の一つ上の行までを指定できる・・ということですか？

 (usamiyu)

 To usamiyuさん

 がんばっているようで重畳。

 まず、今回のコードと、それ以前のコードではレイアウトが異なる。
 以前は C列の値を集計対象にしていたけど、今回のレイアウトはG列の値の集計。
 (実際は G:Iの結合セル）
 今回のレイアウトでもC列もあるので、C列で判定してもよかったけど、一応、集計する値のあるG列を判定したということ。

 むしろ、一番異なっているのは指摘の通り、End(xlup) --> End(xlDown)

 一度、ヘルプのEndプロパティ（Range.Endプロパティ）を読んでみてほしいんだけど
 xlUpは指定したセルから↑方向に、空白ではないセルを見つける。
 xlDownは指定したセルから、最後の空白ではないセルを見つける・

 xlDownの場合、その判定列の途中に空白セルがあると、その手前が最終行と見なされるので
 自分としては基本的には xlUp を使うし、今回も、最終的にはxlUpでよかったなぁとも
 思っているけど、シート要件として途中に空白セルはない（なさそう）だということで
 「なんとなく」xlDownを使った。

 (ぶらっと)

ぶらっとさん、ありがとうございます。
できました。

少しフォーマットを変更したいのですが、
お力を貸していただけますでしょうか。

各フォーマット
1行目　題名
2行目　空白
3行目　文字列
No|縦 |横 |面積
1 |0.211|0.311|0.066
2 |0.211|0.311|0.066
・
・
・

数値が入ってくるのは、5行目からになりました。
上記の場合、文字列の場合は除外みたいな感じで、
If IsNumeric(c.Value) Then
を使用してみましたが、うまくいきませんでした。
どのようにしたらよいでしょうか？
何度もすいません。
(じゅん)

  For Each c In sh.Range("G1", sh.Range("G1").End(xlDown))

 これを

 For Each c In sh.Range("G5", sh.Range("G4").End(xlDown))

 これで試してみて。(今から旅に出るので、何かあったときの対応は、早くて日曜日の夕方になる）

 (ぶらっと)

ぶらっとさん、できました。

お手数おかけしてすいませんでした。

ありがとうございました。

 TO ぶらっとさん
 お答えいただいて、ありがとうございます。
 いつもぶらっとさんのコードを追っかけているので、お返事をいただいて、とってもうれしいです！
 暑さももう少しですが、夏ばてされてないですか？お体ご自愛くださいね。

 最近、End(xlup)、End(xlDown)・・つまずいています。
 >xlUpは指定したセルから↑方向に、空白ではないセルを見つける。
 >xlDownは指定したセルから、最後の空白ではないセルを見つける

 何か、VBEに書いて確認してみます。ctrl+↑、↓で動きを確認してみると、上の記述とは違って、次のようになりましたが、VBEに書いてみるとまたちがうのかなぁ。

 ctrl+↑の場合のﾚｲｱｳﾄ

 あ
 空白行
 空白行
 い
 う
 この行にカーソルを置く

 ここでctrl+↑すると「う」のところにカーソルが動く・・
 だけど、>xlUpは指定したセルから↑方向に、空白ではないセルを見つける。
 だとすると、「あ」のところに動くということですよね？

 と、ここまで書いたところで、ぶらっとさんのコメントがアップされたので、ちょっと
 あせってますが、もし、何か勘違いしているのなら、ご指摘いただければ、幸いです。

 よいご旅行を！

 (usamiyu)

 To (じゅん)さん

 うまくいったようで幸甚。

 To (usamiyu) さん

 >だとすると、「あ」のところに動くということですよね

 う～ん、ちょっと違うね。「う」のところになるはず。

 たしかに、このあたりはややこしいね。で、ますます混乱させるかもしれないけど以下にコードを。
 これを実行して、メッセージと、そのときのシート上のセルの状況を照らしあわせて。
 うんうん　とうなずけるケースと、あれ？なぜ？　というケースが。

 Sub TestDown()
    Dim z As Long

    Columns("A").Clear

    '指定セルを含めてその列に、それ以降何もない場合
    z = Range("A1").End(xlDown).Row
    MsgBox z

    '指定セルには値があるけど、それ以降に値がない場合
    Range("A1").Value = "ABC"
    z = Range("A1").End(xlDown).Row
    MsgBox z

    '指定セルの下に連続して値のあるセルがある場合（このケースのみ本当の最終行が取得可能）
    Range("A1").Value = "ABC"
    Range("A2").Value = "XYZ"
    z = Range("A1").End(xlDown).Row
    MsgBox z

    '指定セルの下に連続して値があり、その後、空白をはさんで値がある場合
    Range("A1").Value = "ABC"
    Range("A2").Value = "XYZ"
    Range("A4").Value = "あいう"
    z = Range("A1").End(xlDown).Row
    MsgBox z

 End Sub

 Sub TestUp()
    Dim z As Long

    Columns("A").Clear

    '指定セルを含めてその列に、それ以降何もない場合
    z = Range("A" & Rows.Count).End(xlUp).Row
    MsgBox z

    '指定セルには値があるけど、それ以降に値がない場合
    Range("A" & Rows.Count).Value = "ABC"
    z = Range("A" & Rows.Count).End(xlUp).Row
    MsgBox z

    '指定セルの上のどこかに値のあるセルがある場合（このケースのみ本当の最終行が取得可能）
    Range("A" & Rows.Count).Value = "ABC"
    Range("A100").Value = "XYZ"
    z = Range("A" & Rows.Count).End(xlUp).Row
    MsgBox z

 End Sub

 Sub TestOther()
    Dim z As Long

    Cells.Clear
    Range("B5").Value = "ABC"
    Range("D100").Value = "XYZ"
    MsgBox ActiveSheet.UsedRange.Address
    z = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Cells.Count).Row
    MsgBox z

    Cells.Clear
    Range("B5").Value = "ABC"
    Range("D100").Value = "XYZ"
    MsgBox Cells.SpecialCells(xlCellTypeLastCell).Address
    z = Cells.SpecialCells(xlCellTypeLastCell).Row
    MsgBox z

    Range("F20").Value = "あいう"
    MsgBox Cells.SpecialCells(xlCellTypeLastCell).Address
    z = Cells.SpecialCells(xlCellTypeLastCell).Row
    MsgBox z

    Range("D100").Clear
    MsgBox Cells.SpecialCells(xlCellTypeLastCell).Address
    z = Cells.SpecialCells(xlCellTypeLastCell).Row
    MsgBox z

 End Sub

 (ぶらっと)

 To　ぶらっとさん

 おかえりなさい！おつかれのところ、こんなにすぐにお答えをいただいて、お手数をおかけして、
申し訳ありません。
 また、いつもどおり、ご丁寧なお答えをいただいて、本当にありがとうございます。

 早速試してみました・・・で、ますます疑問がわいてきました。？？？
 少し頭を整理して、いろいろお伺いしたいことが出てきたのですが、ここは（じゅん）さんの
スレなので、このあとに続けるのは適切じゃないですよね。

 関連部分をコピーして、別途質問を立ち上げますので、また教えていただけますか？
 今日はお疲れでいらっしゃるので、明日以降にまた、教えていただければ、幸せです。

 どうぞよろしくお願いいたします。

 (usamiyu)

コメント返信：

[ 一覧(最新更新順) ]

[[20120914092942]] 『複数ファイルの集計について』（じゅん） ページの最後に飛ぶ

[[20120914092942]]　『複数ファイルの集計について』（じゅん）　ページの最後に飛ぶ