前回質問の続きになりますが、下記マクロでシート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で質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
- Visual Basic(VBA) Sheet2の日付をキーにオートフィルターで2023年1月のデータを抽出し、Sheet3へ書き出すた 2 2023/03/06 23:57
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Excel(エクセル) 並べ替え、ソートの構文がわからない。 お世話になります。VBA超初心者です。 エクセルでワークシート 2 2023/06/28 21:00
- Excel(エクセル) エクセル VBAでシートのコピーを作りたい 1 2023/05/18 07:42
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/10/13 08:41
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/03/02 08:40
- Excel(エクセル) VBAのoffsetの動き方について教えてください 3 2022/11/25 23:36
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
グラフマクロで系列を変数にす...
-
100万件越えCSVから条件を満た...
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
Count Ifのセルの範囲指定に変...
-
Excelで横書き50行の漢字テス...
-
エクセル 複数シートの同一セ...
-
VBAを使って複数のシートから抽...
-
VBA 別ブックからの転記の高速...
-
vba 連続するとうまく作動せず
-
【VBA】特定の条件でセルをコピー
-
Excel VBA オートフィルターで...
-
別シートから年齢別の件数をカ...
-
VB2005でExcelのグラフのデータ...
-
ExcelのVBA ListBox.RowSource...
-
Excel2013で切り取り禁止
-
VBA データ抽出 速度改善
-
上書き、修正、転記
-
VBA webクエリをループさせる...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
マクロ実行後に別シートの残像...
-
VBAコードについて
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
VBA 別ブックからの転記の高速...
-
【VBA】特定の条件でセルをコピー
-
VBA別シートの最終行の次行へ転...
-
100万件越えCSVから条件を満た...
-
VBAで変数の数/変数名を動的に...
-
Changeイベントで複数セルへの...
-
楽天RSSからエクセルVBAを使用...
-
Count Ifのセルの範囲指定に変...
-
Unionでの他のシートの参照につ...
-
Excel2013で切り取り禁止
-
Excel VBA オートフィルターで...
-
VBA 実行時エラー1004 rangeメ...
-
複数シートの複数列に入力され...
-
VBA Userformで一部別シートに...
-
ExcelのVBマクロを、バックグラ...
おすすめ情報
わかりました。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
とても助かりました。