
前回質問の続きになりますが、下記マクロでシート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

No.2ベストアンサー
- 回答日時:
>図の縦横の項目を抽出条件に交差するセルの値を求めるためのループ処理を教えていただけませんでしょうか。
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を使うのが良いと思います
ありがとうございます。下記コードで縦横全てのセルに「0」が入りました。少しずつ理解し始めましたが、後、何が足りないか教えてください。
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").Cells(i, "C").Text
Sheets("Sheet2").Cells(i, j).Value = .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
End With
Next
Next
End Sub
No.1
- 回答日時:
この質問の直接の回答ではありません。
前回の質問
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
EXCELのSheet番号って変更でき...
-
マクロの「SaveAs」でエラーが...
-
100万件越えCSVから条件を満た...
-
マクロ実行後に別シートの残像...
-
【VBA】データを各シートに自動...
-
楽天RSSからエクセルVBAを使用...
-
VBA 空白行に転記する
-
ExcelのVBAでグループ分けしたい
-
Excel VBA マクロ データ抽出
-
複数シートの複数列に入力され...
-
別シートから年齢別の件数をカ...
-
Excel2013で切り取り禁止
-
Unionでの他のシートの参照につ...
-
VB2005でExcelのグラフのデータ...
-
VBA : エクセルの列を5列追加し...
-
エクセルVBA:軸の設定でエラー...
-
vlookup&部分一致の文字列のル...
-
【VBA】特定の条件でセルをコピー
-
VBAでEXCELから固定長...
-
VBAコードについて
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
EXCELのSheet番号って変更でき...
-
VBA別シートの最終行の次行へ転...
-
VBA 空白行に転記する
-
マクロ実行後に別シートの残像...
-
Count Ifのセルの範囲指定に変...
-
楽天RSSからエクセルVBAを使用...
-
VBA 別ブックからの転記の高速...
-
VBAで変数の数/変数名を動的に...
-
Changeイベントで複数セルへの...
-
100万件越えCSVから条件を満た...
-
【Excel VBA】自動メール送信の...
-
VBA 実行時エラー1004 rangeメ...
-
エクセルでデータの比較をした...
-
アクセスからエクセルへ出力時...
-
Excel VBA オートフィルターで...
-
【VBA】データを各シートに自動...
-
複数シートの複数列に入力され...
-
Unionでの他のシートの参照につ...
-
VBA Userformで一部別シートに...
おすすめ情報
わかりました。AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Range("C2").txt へ修正し3の値が求められました。
追加の質問になりますが、図の縦横の項目を抽出条件に交差するセルの値を求めるためのループ処理を教えていただけませんでしょうか。
ありがとうございます、下記でできました。
AutoFilter Field:=2, Criteria1:=Sheets("Sheet2").Cells(i, "B").Text
.AutoFilter Field:=1, Criteria1:=Sheets("Sheet2").Cells("2", j).Text
とても助かりました。