anya9999
@anya9999 (N A)

Are you sure you want to delete the question?

Leaving a resolved question undeleted may help others!

EXCEL VBAで複数条件の小計を出す処理を自動化したいです

解決したいこと

EXCEL VBAで複数条件の小計を出す処理を自動化したいです。
下記の、Sheet1,Sheet2… から Sheet集計 をつくりたいです。
参考サイト、類似処理のコード等、教えてください。

Sheet1
商品名	サイズ	個数
A	1	100
B	2	100
C	3	100
C	1	100
B	2	100

Sheet2
商品名	サイズ	個数
A	1	100
D	1	100
B	3	100
B	2	100

Sheet集計
商品名	サイズ	合計個数
A	1	200
B	2	300
B	3	100
C	1	100
C	3	100
D	1	100

発生している問題・エラー

商品名はA~Dだけでなく、E,F…と増えていく可能性あり、サイズも同様。元のシートは17〜16個ほどあることが多いです。
対応できるように項目とデータ数、シート数は元のファイルから取得したいです。

自分で試したこと

まず、すべてのシートを縦に結合します。

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A1").Select
    ActiveCell.Formula2R1C1 = _
        "=FILTER(VSTACK(Sheet1:Sheet8!RC:R[199]C),VSTACK(Sheet1:Sheet8!RC:R[199]C)<>0)"
    Range("A1").Select
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Range("C1").Select
    ActiveSheet.Paste
End Sub

これでは、Sheet8までしか対応していないので、ブックのシート数に合わせて書き換える必要があります。

=VSTACK(最初のシートを自動取得:最後のシートを自動取得!A1:C200)
こんな感じにしたいです。
少しいじってみました。

Sub Macro1()

'変数の宣言 ワークシート型

Dim 最初のシート As Worksheet
Dim 最後のシート As Worksheet

'変数に値を代入

Set 最初のシート = Worksheets(2)
Set 最後のシート = Worksheets(Sheets.Count)

'A行の処理

    Range("A1").Select
    ActiveCell.Formula2R1C1 = _
        "=FILTER(VSTACK(最初のシート:最後のシート!RC:R[199]C),VSTACK(最初のシート:最後のシート!RC:R[199]C)<>0)"
        
'B,C行も同様に

    Range("A1").Select
    Selection.Copy
    Range("B1").Select
    ActiveSheet.Paste
    Range("C1").Select
    ActiveSheet.Paste
    
'Macro2

End Sub

こちら実行すると、「値の更新:最後のシート」という題の保存画面が開いてしまいます。A1:C1には、「#NAME?」エラーが表示されます。

下記は結合後のデータに行いたい処理です。

Sub Macro2()
'
' Macro2 Macro
'

'
    Range("G1").Select
    ActiveCell.Formula2R1C1 = "=UNIQUE(RC[-6]:R[199]C[-5])"
    Range("I1").Select
    ActiveCell.Formula2R1C1 = _
        "=SUMIFS(RC[-6]:R[199]C[-6],RC[-8]:R[199]C[-8],RC[-2]:R[199]C[-2],RC[-7]:R[199]C[-7],RC[-1]:R[199]C[-1])"
    Range("I2").Select
    
End Sub
0

2Answer

自分で試したこと

試したVBAや数式を質問欄に貼り付けて欲しいのですが。。。

0Like

Comments

  1. @anya9999

    Questioner

    一つのシート上を対象に行ったものをマクロの記録で記録したところ、下記のようになりました。これをブック内のすべてのシートを対象にしたいです。

    ”Sub Macro2()
    '
    ' Macro2 Macro
    '

    '
    Range("G1").Select
    ActiveCell.Formula2R1C1 = "=UNIQUE(RC[-6]:R[199]C[-5])"
    Range("I1").Select
    ActiveCell.Formula2R1C1 = _
    "=SUMIFS(RC[-6]:R[199]C[-6],RC[-8]:R[199]C[-8],RC[-2]:R[199]C[-2],RC[-7]:R[199]C[-7],RC[-1]:R[199]C[-1])"
    Range("I2").Select
    End Sub

  2. 数式で出来そうです。

    "Sheet集計"シートの
    "A1"セルに =VSTACK(Sheet1:Sheet3!A1:C200)を、
    "E1"セルに =UNIQUE(A:B)を、
    "G2"セルに =SUMIFS(C2:C1000,A2:A1000,E2:E1000,B2:B1000,F2:F1000)を入力する。

    "A1"セルのC200200は、Sheet1〜Sheet3の中で最大の行数。
    "G2"セルのC1000,A1000...F10001000は、"A1"セルの最大行数。

  3. @anya9999

    Questioner

    =VSTACK(Sheet1:Sheet3!A1:C200)
    だと、3シートしか集計出来ないのですが、これをブック内の全てのシートを指定出来たりしませんか?ブックによってシート数が違い、20シート弱が多いです。
    =VSTACK(最初のシートを自動取得:最後のシートを自動取得!A1:C200)
    こんな感じにしたいです。

  4. Sheet1:Sheet3と書くと、シートの並びで、Sheet1からSheet3の間にある全てのシートが対象という意味です。
    もし、シート数が不定ならば、シートの並びの先頭にダミーのSheet_start、最終にダミーのSheet_endシートを置けば、Sheet_start:Sheet_endとすることで、(シート数によらず)対象にできます。
    Sheet1:Sheet99とかでもよいです。Sheet99はダミーシート)

  5. @anya9999

    Questioner

    ありがとうございます。
    ダミーのシートを作成するのもありですね。VSTACK関数の範囲をブックごとに書き直すのと、人が行う作業量があまり変わらない気はしてしまいますが。

  6. VSTACK関数の範囲をブックごとに書き直すのと、人が行う作業量があまり変わらない気はしてしまいますが。

    VSTACK関数の範囲をブックごとに書き直す手前をなくすために、あらかじめダミーシートで挟むのです。

  7. @anya9999

    Questioner

    こちらの処理をパソコン初心者が使うことも想定していまして(建設業で職人上がりの上司など)「ダミーシートをこの位置に一言一句同じ題で作って…」とか説明してもたぶん伝わらなくて上手く動かないはずなんです。

    ダミーシートを作る部分もマクロの実行だけで出来るように考えてみます。丁寧にご説明ありがとうございました。

頭の体操として書いてみました。

Sub aggregate()
  ' 集計シートを1枚目に置くことを条件とする

  ' 既存の集計シートがあれば削除(キャンセルでマクロ終了)
  If Worksheets(1).Name = "集計シート" Then
    If Not Worksheets(1).Delete Then Exit Sub
  End If

  ' 新しい集計シートの作成準備
  strDataAddress = "" ' VSTACK するセル範囲のアドレス
  For Each ws In Worksheets ' 全てのシートをチェックしてデータ範囲のアドレスを書き出す
    dataRows = ws.Range("A1").CurrentRegion.Rows.Count - 1
    strDataAddress = strDataAddress & "," & ws.Name & "!" & _
                     ws.Range("A2").Resize(dataRows, 3).Address
  Next ws
  strDataAddress = Mid(strDataAddress, 2) ' 先頭の余分な","を削除

  ' 集計シートの作成
  Set wsAggregate = Worksheets.Add(Worksheets(1)) ' 集計シートを1枚目に置く
  With wsAggregate
    .Name = "集計シート"
    .Range("A2").Formula2 = "=VSTACK(" & strDataAddress & ")" ' 集計シートA2に VSTACK 関数を書く
    Set rangeStack = .Range("A2").CurrentRegion ' VSTACK されたデータのセル範囲
    Set rangeStack_AB = rangeStack.Columns("A:B") ' 上記範囲中で商品名・サイズのセル範囲
    ' 集計シートE2に UNIQUE 関数および SORT 関数を書く
    .Range("E2").Formula2 = "=SORT(SORT(UNIQUE(" & rangeStack_AB.Address & "),2),1)"
    Set rangeUnique = .Range("E2").CurrentRegion ' 商品名・サイズのセル範囲
    ' SUMIFS 関数の式を作り、集計シートG2に SUMIFS 関数を書く
    formulaSumifs = Join(Array(rangeStack.Columns(3).Address, _
                               rangeStack.Columns(1).Address, rangeUnique.Columns(1).Address, _
                               rangeStack.Columns(2).Address, rangeUnique.Columns(2).Address), ",")
    .Range("G2").Formula2 = "=SUMIFS(" & formulaSumifs & ")"
    .Range("A1:C1") = Array("商品名", "サイズ", "個数")
    .Range("E1:G1") = Array("商品名", "サイズ", "合計個数")
  End With
End Sub

最初の解答から何度か改良しました。おそらく最終版です。
実行後の画面です。

image.png

シートの枚数や商品・サイズの種類、シートあたりの行数に制限はありません。
全てVBAで取得します。

質問者の方はおそらく「マクロの記録」を利用されているようですが、私も最初はそこから勉強を始めました。

「それを簡潔に記述できないか?」
(他人の書いたマクロを見て)「どうして動作するのだろう?」
の繰り返しで多少はまともなコードを書けるようになってきました。
学習にはある程度の時間が必要です。

ご健闘をお祈りします。

0Like

Comments

  1. @anya9999

    Questioner

    ありがとうございます。
    VBAの勉強を進めます。

    試すのが遅くなってしまいました。
    8月30日に、上記のコードを試させてもらいました。

    エラーが出てしまいます。

    image.png

    貼り付ける位置などが間違っているのでしょうか?

    image.png

  2. お試しいただき、ありがとうございます。
    トラブルの件、了解いたしました。

    貼り付ける場所についての説明が不十分でした。

    Excel を起動後、Alt + F11([Alt]キーを押しながらファンクションキー[F11]を押す)でVBE (Visual Basic Editor) が起動します。

    VBE のメニューから [挿入] - [標準モジュール] を選択して、そちらに貼り付けてください。
    image.png

    赤丸のようになっていれば O.K. です。
    image.png

    VBE 上で実行(F5)してもいいですし、Excel からは Alt + F8 でマクロの実行画面が出ますので「aggregate」を実行してもいいです。
    image.png

    もし、エラーが出るようならばご連絡ください。

  3. こちらでもあらためて検証してみました。

    質問者様の貼り付け場所でも、想定した動作をしましたので、データシートの内容についてもご確認ください。
    (なお、推奨する貼り付け場所は上記コメントのとおりです。)

    こちらが検証した条件は、質問者様の提示された様式の2枚のシートだけが入ったブックです。

    「データは行1にデータ見出しがあり、列はAからCの3列、データ範囲は空白で囲まれており範囲内にはデータ以外の情報は存在しない。
    ことが条件になります。

    image.png

    image.png

  4. @anya9999

    Questioner

    image.png

    ありがとうございます。
    また、エラーが出てしまいました。

  5. その画面で、「デバッグ」をクリックしたときに、表示されたスクショをお願いいたします。

  6. なお、作られた「集計シート」が最も上に置かれていないとエラーになります。

  7. @anya9999

    Questioner

    image.png

    デバッグを押したときのスクショは上記になりました。

    一番左側に空白の「集計シート」は作成されています。

    計算元のシート数は増やしましたが、「データは行1にデータ見出しがあり、列はAからCの3列、データ範囲は空白で囲まれており範囲内にはデータ以外の情報は存在しない。」は満たしております。

  8. 念のために確認です。
    Excel のバージョンはいくつでしょうか。

    VSTACK 関数は Office 365 から使える関数ですが、大丈夫でしょうか?
    VBA の Formula2 も新しいバージョンで使用可能です。

    バージョンが古い場合は、コードを手直しする必要があります。

  9. @anya9999

    Questioner

    職場、私用、共に365でした。

  10. 了解いたしました。

    シートを、こちらが検証した2枚「sheet1」「sheet2」と同じものを用意する。
    それ以外のシートを削除(「集計シート」の削除)する。

    この条件で実行していただき、エラーが出た時の Excel のスクショ(特にシート選択の位置がわかれば O.K. です。)も教えてください。

    なお、時間的に都合が悪ければ、遠慮無く申し出てください。
    こちらは勉強を兼ねておりますので、ありがたくお付き合いさせていただきます。

  11. おそらくの原因が判明しました。

    質問者様のスクショを見たところ、シート名に空白文字が含まれています。
    [Sheet1 と (5) の間]など...

    シート名に空白文字が含まれていても動作するように手直ししました。

    上から13行目

        strDataAddress = strDataAddress & "," & ws.Name & "!" & _
    

        strDataAddress = strDataAddress & ",'" & ws.Name & "'!" & _
    

    に変更してください。

    わかりにくいのですが、下図のシングルクォートの追加です。

    image.png

    シート名に空白文字があったため、VSTACK関数でエラーが出たようです。

  12. @anya9999

    Questioner

    変更後、エラーが出ていたブックでもエラーが出なくなりました。

    image.png

    ちなみに、プログラム変更前の下記検証もエラーが出なかったです。

    シートを、こちらが検証した2枚「sheet1」「sheet2」と同じものを用意する。
    それ以外のシートを削除(「集計シート」の削除)する。

    image.png

    ーーーーーーーーーーーーーーーーーーーーーーーーーー
    解決しました!
    ありがとうございます。
    返信の間隔が開くことが多くて申し訳なかったです。

  13. お役にたてて幸いです。
    こちらもトラブル事例の勉強になりました。

    何事も経験の積み重ねですね。

    解決でしたら、質問をクローズされてください。

Your answer might help someone💌