![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
前回質問の続きになりますが、下記マクロでシート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
![「前回質問の続きになりますが、下記マクロで」の質問画像](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/2/543097098_6389b95a700e9/M.jpg)
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ランキング
-
VBA 別ブックからの転記の高速...
-
マクロ実行後に別シートの残像...
-
VBA 重複チェック後に値をワー...
-
【VBA】データを各シートに自動...
-
Changeイベントで複数セルへの...
-
Count Ifのセルの範囲指定に変...
-
楽天RSSからエクセルVBAを使用...
-
テキストボックスから、複数の...
-
VBA 実行時エラー1004 rangeメ...
-
VBA Userformで一部別シートに...
-
マクロの「SaveAs」でエラーが...
-
Excel2013で切り取り禁止
-
再質問です。マクロの修正箇所...
-
vba 2つの条件が一致したら...
-
あああ..ああい..ああう とい...
-
【Excel関数】UNIQUE関数で"0"...
-
B列の最終行までA列をオート...
-
Excel UserForm の表示位置
-
ワイルドカード「*」を使うとう...
-
[EXCEL]ボタン押す→時刻が表に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
VBA 空白行に転記する
-
EXCELのSheet番号って変更でき...
-
マクロ実行後に別シートの残像...
-
VBA別シートの最終行の次行へ転...
-
Count Ifのセルの範囲指定に変...
-
Changeイベントで複数セルへの...
-
VBAで変数の数/変数名を動的に...
-
VBA 別ブックからの転記の高速...
-
【VBA】特定の条件でセルをコピー
-
VBA 実行時エラー1004 rangeメ...
-
楽天RSSからエクセルVBAを使用...
-
Unionでの他のシートの参照につ...
-
複数シートの複数列に入力され...
-
ExcelのVBマクロを、バックグラ...
-
100万件越えCSVから条件を満た...
-
VBA Userformで一部別シートに...
-
Excel VBA オートフィルターで...
-
Excel2013で切り取り禁止
-
VBAでEXCELから固定長...
おすすめ情報
わかりました。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
とても助かりました。