前回質問の続きになりますが、下記マクロでシート1からシート2の抽出項目セルB3「りんご」とセルC2「

Question

前回質問の続きになりますが、下記マクロでシート1からシート2の抽出項目セルB3「りんご」とセルC2「2022/10/14」でフィルターした結果をシート2のセルC3へ入れると、0件になってしまいます。10/14のりんごは3件あるのですがなぜだか教えていただけませんでしょうか。
Sub test2()
        With Sheets("Sheet1").Range("B2").CurrentRegion
            .AutoFilter Field:=2, Criteria1:=Sheets("Sheet2").Range("B3").Value
            .AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("C2").Value
            Sheets("Sheet2").Range("C3").Value =　_
　　　 .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
        End With
End Sub

Qchan1962 · Accepted Answer

＞図の縦横の項目を抽出条件に交差するセルの値を求めるためのループ処理を教えていただけませんでしょうか。

Sub sample()
Dim i As Long, j As Long
Dim answer
For i = 3 To 6 '行
For j = 3 To 8 '列
Cells(i, j).Value = answer+1
Next
Next
End Sub

これをご質問のコードに応用すると

Sub sample2()
Dim i As Long, j As Long
Dim lastRow As Long, lastColm As Long
lastRow = Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row
lastColm = Sheets("Sheet2").Cells(2, Columns.Count).End(xlToLeft).Column
For i = 3 To lastRow '行
For j = 3 To lastColm  '列
With Sheets("Sheet1").Range("B2").CurrentRegion
.AutoFilter Field:=2, Criteria1:=Sheets("Sheet2").Cells(i, "B").Text
.AutoFilter Field:=1, Criteria1:=Sheets("Sheet2")・・・
・・・ =  .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
End With
Next
Next
End Sub

・・・は割愛
Range("C2")だと書きにくいので繰り返し処理の場合Cellsを使うのが良いと思います

tatsumaru77 · Answer

この質問の直接の回答ではありません。
前回の質問
https://oshiete.goo.ne.jp/qa/13253095.html
の回答になります。
フィルターは使用していません。以下のマクロを標準モジュールに登録し
実行してください。

Option Explicit

Public Sub 出荷日別個数一覧()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim erow2 As Long: erow2 = 3
    Dim ecol2 As Long: ecol2 = 3
    Dim maxrow As Long
    Dim wrow As Long
    Dim row2 As Long
    Dim col2 As Long
    Dim dicT1 As Object     '品名の行番号
    Dim dicT2 As Object     '日付の列番号
    Dim key1 As Variant     '品名
    Dim key2 As Variant     '日付
    Set dicT1 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set dicT2 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")
    sh2.Cells.ClearContents
    maxrow = sh1.Cells(Rows.Count, "B").End(xlUp).Row    'sheet1の最大行取得
    For wrow = 3 To maxrow
        key1 = sh1.Cells(wrow, "D").Value
        key2 = sh1.Cells(wrow, "B").Value
        If dicT1.exists(key1) = False Then
            sh2.Cells(erow2, "B").Value = key1
            dicT1(key1) = erow2
            erow2 = erow2 + 1
        End If
        If dicT2.exists(key2) = False Then
            sh2.Cells(2, ecol2).Value = key2
            dicT2(key2) = ecol2
            ecol2 = ecol2 + 1
        End If
        row2 = dicT1(key1)
        col2 = dicT2(key2)
        sh2.Cells(row2, col2).Value = sh2.Cells(row2, col2).Value + 1
    Next
    MsgBox ("完了")
End Sub

前回質問の続きになりますが、下記マクロでシート1からシート2の抽出項目セルB3「りんご」とセルC2「

＞図の縦横の項目を抽出条件に交差するセルの値を求めるためのループ処理を教えていただけませんでしょうか。

この質問の直接の回答ではありません。

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

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

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