Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の

Question

Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の条件は同じで2つ目の条件がSheet2のB列に20個縦に並んでいるのですが、
下記のように同じようなマクロを20個書くのではなく抽出条件２をSheet2のB列から持ってくる方法を教えてください。

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

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

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

tatsumaru77 · Accepted Answer

Sub りんごA()を
Sub 指定品名抽出(ByVal hinmei As String)
変えます。
そして、
Range("B4").AutoFilter 6, "りんごA"　を
Range("B4").AutoFilter 6, hinnmei 
に変えます。

指定品名抽出を呼び出すとき、Sheet2のB3を指定します。（B3＝りんごA）

結果として以下のようになります。

Sub 抽出()
'りんごA　の場合
    Call 指定品抽出(Worksheets("Sheet2").Cells(3, "B").Value)
End Sub

Sub 指定品名抽出(ByVal hinmei As String)
'オートフィルターで抽出
    Dim Count As Long
    With Worksheets("Sheet3")
        '・・・途中省略・・・
        '抽出条件2
        Range("B4").AutoFilter 6, hinmei
        '・・・途中省略・・・
    End With
'・・・以降省略・・・
End Sub

tatsumaru77 · Answer

失礼しました。
指定品抽出　ではなく
指定品名抽出　でした。
以下のようにしてください。

Call 指定品名抽出(Worksheets("Sheet2").Cells(3, "B").Value)

めぐみん_ · Answer

検証できないので間違っているかもですが、CountIfs関数ならフィルタをかける・解除する（確か必要だったかな？）は不要になるかと。
遠い記憶の事なので参考程度になれば。

めぐみん_ · Answer

直接の回答ではないですが。
－－－－－－
For c = 3 To 14 '４月～3月の範囲
If .Cells(2, c).Value = Worksheets("Sheet1").Range("A2").Value Then
Worksheets("Sheet2").Cells(3, c) = Count - 1
Exit For
End If
Next c '該当月の指定
－－－－－－

の部分って『月』で列番号を得たいのですよね？
そしてセルの値はシリアル値？
その場合にはループさせ比較する必要はないと思いますよ。

MONTH 関数
https://support.microsoft.com/ja-jp/office/month-%E9%96%A2%E6%95%B0-579a2881-199b-48b2-ab90-ddba0eba86e8

で何月なのかを調べ -1 すれば列番号です。
ただし1~3月については先に+12して13~15としてから-1になりますかね。
２０年位にＶＢＡ覚えたての際の回答者様たちは、このようなやり方多かったです。

参考になれば幸いです。

ちなみに今回の質問であればループ処理になるでしょうけど、SubtotalよりはCountIfsの方が先の質問も含め良いようにも感じました。
が、検証できない初級者なのでベテラン回答者様にお任せです。

Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の

Sub りんごA()を

失礼しました。

検証できないので間違っているかもですが、CountIfs関数ならフィルタをかける・解除する（確か必要だったかな？）は不要になるかと。

直接の回答ではないですが。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング