前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ

前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループできないか下記コードで試したところエラーにはなりませんが、最上段のセルL3に「0」が入って終わってしまいました。全ての品名のカウントを変数cで指定したL列のぶどうDまで入力するにはどのようにしたらよいか教えてください。

Sub 抽出()
'品名呼び出し
Dim i
For i = 3 To 22
Call 指定品名抽出(Worksheets("Sheet2").Cells(i, "B").Value)
Next i
End Sub

Sub 指定品名抽出(ByVal hinmei As String)
　　　'オートフィルターで抽出
　Dim Count As Long
　With Worksheets("Sheet3")
'抽出条件1
Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個, xlFilterValues
'抽出条件2
Range("B4").AutoFilter 6, hinmei
　Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1))
　End With

'処理月へ転記
Dim c As Long
Dim d As Long
With Worksheets("Sheet1")
For c = 3 To 14 '４月～3月の範囲
For d = 3 To 22
If .Cells(2, c).Value = Worksheets("Sheet1").Range("A2").Value Then
Worksheets("Sheet2").Cells(3, c) = Count - 1
Exit For
End If
Next d
Next c '該当月の指定
End With
Application.CutCopyMode = False
End Sub

質問者からの補足コメント

• 説明不足で申し訳ございません。Sheet１、Sheet2、Sheet3について補足させていただきます。
  ・「Sheet1セルA2」の日付は、Sheet２の2行目の月と一致させるために使います。
  ・「Sheet2」は「Sheet３」の集計結果を取りまとめるのに使います。
  補足の図を追加させていただきます。

  
    補足日時：2023/01/14 11:42

• ご指南いただいた下記コードで抽出を実行したところ、エラーにはなりませんでしたがSheet2のL列への転記ができませんでした。Sheet3を見たところ、2つの条件で最終行の項目ぶどうDが抽出されていました。（画像参照)
  End With以下のコード'処理月へ転記でSheet2各項目りんごAからぶどうDまで、Sheet3から2条件で抽出した件数を転記するイメージなのですが...画像のように最後に抽出したぶどうDの個数は8個なので、Sheet2セルL22には8が入るイメージです。しかしL列は、全ての項目が空白です。

  
    補足日時：2023/01/14 17:20

• '処理月へ転記
  Dim c d
  With Worksheets("Sheet1")
  For c = 3 To 14 '４月～3月の範囲
  For d = 3 To 22
  If .Cells(2, c).Value = Worksheets("Sheet1").Range("A2").Value Then
  Worksheets("Sheet2").Cells(d, c) = Count - 1
  Exit For
  End If
  Next d
  Next c '該当月の指定
  End With
  End Sub

    補足日時：2023/01/14 17:24

No.6 ベストアンサー 回答者： tatsumaru77 回答日時： 2023/01/15 10:13

修正版を下記にアップしました。

https://ideone.com/LcVQIS
不明点があれば、補足してください。

この回答へのお礼

こんなことひょっとしたら…できたらいいな!と毎回質問させていただいていますが、イメージどおりの答えを用意していただき感謝です。今回は、プロシージャのタイトルについている()の意味とByVal：値渡しについて勉強させていただきました。ありがとうございます。

お礼日時：2023/01/15 23:43

No.7 回答者： めぐみん_ 回答日時： 2023/01/15 20:27

＞For c = 3 To 14 '４月～3月の範囲

＞Worksheets("Sheet2").Cells(d, c) = Count - 1

ここの変数:c は１つ目の品名でどの列かわかりますよね？
品名全てでループをさせ列を探すより、変数の宣言をSubプロシージャーの外で行なえば、１度取得できた列番号は初期化されずに済むのでは？
と言う方法もありますね。

この回答へのお礼

ありがとうございます。勉強してみます。

お礼日時：2023/01/15 23:44

No.5 回答者： めぐみん_ 回答日時： 2023/01/14 18:17

シート２の２行目って昨年値を入れたのなら、１月～３月って2022年になっていたりはしませんよね？（フィルコピーしたとしたらならないかもですが）

でもＬ３に 0 が入っている？のもおかしいですし。

やっぱ人の作成したコード解析は難しいですね。
⇒回答者間でもあり得る事です。
考え方がそれぞれに違いますので。

作成されたベテラン様にお任せするしかないかも？
私の場合だと４～３月の年度方式でも、○○年は無視して『月』で列を決め打ちしますし。（１～１２月でもそうですけど）

No.4 回答者： めぐみん_ 回答日時： 2023/01/14 13:14

'抽出条件1

.Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個", xlFilterValues '★

ミスりました。

'抽出条件1
.Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個"), xlFilterValues '★

こちらです。

No.3 回答者： めぐみん_ 回答日時： 2023/01/14 13:11

Sub 指定品名抽出(ByVal hinmei As String)

　　　'オートフィルターで抽出
　Dim Count As Long
　With Worksheets("Sheet3")
'抽出条件1
Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個, xlFilterValues
'抽出条件2
Range("B4").AutoFilter 6, hinmei
　Count = WorksheetFunction.Subtotal(3, Range("B4").CurrentRegion.Columns(1))
　End With

↓

Sub 指定品名抽出(ByVal hinmei As String)
　　　'オートフィルターで抽出
　Dim Count As Long
　With Worksheets("Sheet3")
'抽出条件1
.Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個", xlFilterValues '★
'抽出条件2
.Range("B4").AutoFilter 6, hinmei '★
　Count = WorksheetFunction.Subtotal(3, .Range("B4").CurrentRegion.Columns(1)) '★
　End With

ありがちな with~end with を使った際に該当するシートに対するオブジェクトを関連させる『先頭の "."』をつけ忘れているからとか？
たまたまそのシートがアクティブ状態ならエラーにはならないでしょう。

あと画像では昨年１２月のデータみたいですが今年１月のデータありますか？
それと試しに手作業でのフィルタにて１月のデータが抽出されるか確認すべきかも。

No.2 回答者： めぐみん_ 回答日時： 2023/01/14 05:59

＞品名りんごAから順に20回for nextでループできないか

これは

Sub 抽出()
'品名呼び出し
Dim i
For i = 3 To 22
Call 指定品名抽出(Worksheets("Sheet2").Cells(i, "B").Value)
Next i
End Sub

ここでやっていることですよね？
そうすると

＞For d = 3 To 22
＞Next d

っていらないのでは？
中のIf文は必要ですけど、変数：dは何もしていないようですし。

あと
＞Application.CutCopyMode = False

これも。

ただ原因は違うかもですね。
まさかですけど2023/1/?のデータはまだ入っていないとか？

この回答へのお礼

すいません。Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース", "1個"), xlFilterValues
でした。

お礼日時：2023/01/14 11:07

No.1 回答者： tatsumaru77 回答日時： 2023/01/13 22:27

提示されたマクロをコピペして、こちらで表示すると、

抽出条件１の
Range("B4").AutoFilter 2, Array("五個入り", "10個入り", "ケース ", "1個, xlFilterValues
がエラー表示されます。
添付図参照。（赤線で囲んだ箇所です）
本当にこれで、実行できたのでしょうか。