[[20190927133541]]　『VBA 複数シート集計・連続実行』（hideminn）　ページの最後に飛ぶ

『VBA 複数シート集計・連続実行』（hideminn）

マクロ初心者です。
【シート】が30シートあり、DBから❶のコードで各シートにデータ抽出→集計（合計）しています。
【シート1】に連続実行のボタンを作成し、
❷の連続実行で各シートにデータは抽出されますが
合計値が【シート1】に反映されてしまいます。
合計値のコードがWorksheetになっているからでしょうか。。。

連続実行で各シートの【J列最後尾+1】のセルに合計値を出したいのですが
ご教示頂けますでしょうか。
よろしくお願いいたします。

❶各シートのプログラム
Sub リンゴ()

  Dim WS2 As Worksheet
  Dim fR As Range, CopyTo As Range
  Dim c
  Dim Criteria: Criteria = Array("820678")

  Set WS2 = Worksheets("リンゴ")
  WS2.UsedRange.ClearContents
  Set CopyTo = WS2.Range("A3")

  Set fR = Worksheets("DB").Range("A3").CurrentRegion
  fR.AutoFilter
  For Each c In Criteria
      fR.AutoFilter 11, c
      fR.Copy CopyTo
      fR.AutoFilter
      Set CopyTo = WS2.Cells(Rows.Count, 1).End(xlUp).Offset(1)

 With Range("j4")
        .End(xlDown).Offset(1, 0) = _
            "=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
    End With

      Next

End Sub

❷連続実行
Sub 連続実行()
Call リンゴ
Call みかん
call いちご
　　・
　　・
　　・

 End Sub

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 ＞ With Range("j4")

 を　With WS2.Range("j4")

 にしてみては？

（渡辺ひかる） 2019/09/27(金) 15:33

渡辺様

ご回答くださいましてありがとうございます。
試してみたのですが、
??Rangeﾒｿﾞｯﾄは失敗しました??とのエラーがでしまいます。

With WS2.Range("j4")

        .End(xlDown).Offset(1, 0) = _
            "=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
    End With
（hideminn） 2019/09/27(金) 16:36

　>各シートにデータ抽出→集計（合計）しています。

ということは、

0）作業開始（プログラム始め）
1）りんごというシートに820678という番号のものを(どのブックのどのシートのどのセル範囲から？）抽出して転記
2）みかんというシートに??????という番号のものを抽出して転記
　・
　・
以下シートがある限り繰り返し

という風に命令したいのですよね？

ということは、
1）元の表はどのブックのどのシートのどの範囲？
2）「りんご」などの抽出先のシートはどのブック？
3）りんごと820678という番号の相関関係は？
等の情報を明示する必要があると思います。

まずは、メインのプロシージャを上記のように書いて、
子プロシージャには変わる部分を変数で受けて、
抽出＆コピーをする役割（あるいは機能）だけを与えるように、
考えてみてください。

とりあえず、まともに動かなくてもいいと思うので、
前提条件の整理と作業の流れを今一度整理して、
思った通りに書いてみて、それらの情報＆コードをここに提示して、
どなたかに添削していただくという方向で話を進めていくというのはどうでしょうか？
（まっつわん） 2019/09/27(金) 16:41

 With句の中を以下にしてください

        With WS2.Range("j4")
            .End(xlDown).Offset(1, 0) = _
            "=SUM(" & WS2.Range(.Address, .End(xlDown).Address).Address(False, False) & ")"
        End With

 それと　
 Criteria = Array("820678")　で　配列にしてループする必要があるのですか？

 他のプロシージャでは複数指定しているとか？

（渡辺ひかる） 2019/09/27(金) 17:14

まっつわん様
ご丁寧にご教示くださいましてありがとうございます。
（hideminn） 2019/09/27(金) 17:28

渡辺様

お陰様でできました！
分かりにくい質問にご回答くださりありがとうございます。

("820678")　はDBシートの【リンゴ】に属するコード番号で
このコード番号で抽出しています。

とても助かりました。ありがとうございます。
（hideminn） 2019/09/27(金) 17:34

話が終わってるっぽいけど、渡辺ひかるさんがいってるのは、プロシージャ"リンゴ"を整理すると

    Sub リンゴ()

        Dim 貼付先 As Range

        '▼リンゴシートの話
        With Worksheets("リンゴ")
            .UsedRange.ClearContents
            Set 貼付先 = .Range("A3")
        End With

        '▼DBシートの話
        With Worksheets("DB")
            '▼オートフィルタ強制解除
            .AutoFilterMode = False

            '▼A3セルを含む表範囲にオートフィルタを設定して、11列目を"820678"で抽出
            .Range("A3").AutoFilter Field:=11, Criteria1:="820678"

            '▼抽出されているものをタイトル行ごとコピペ
            .AutoFilter.Range.Copy 貼付先

        End With

        '▼アクティブシートの話
        With ActiveSheet.Range("j4")
             .End(xlDown).Offset(1) = _
                "=SUM(" & Range(.Cells, .End(xlDown)).Address(False, False) & ")"
        End With

    End Sub

こんな感じになるから、ループする必要がないっていってるんだとおもいますよ。

（もこな２） 2019/09/27(金) 18:27

コメント返信：

[ 一覧(最新更新順) ]

[[20190927133541]] 『VBA 複数シート集計・連続実行』（hideminn） ページの最後に飛ぶ

[[20190927133541]]　『VBA 複数シート集計・連続実行』（hideminn）　ページの最後に飛ぶ