Q&A
Dim Kw As の行で構文エラーになりコード自体実行できないと思いますが。
実際のコードをコピーして貼り付けください。でないと間違いの指摘はできません。
＜やりたいこと＞
・"Sheet1"に元データがあります。"Data"シートに抽出シートしたデータがあり、毎回行数が変わります。
・Dataシートの行数分、抽出を繰り返します。今回ですと３回になります。
・抽出結果を"Sheet2"に貼り付けます。
・抽出結果は１行ごとにひとかたまりで、Sheet1でフィルターをかけます。手動でやりますとおよそ10行くらい抽出されます。ですので、Sheet2は30行くらいになります。
<エラー内容＞
”Data”シートの２行目のデータしか検索されず、他の３行目、４行目は検索されませんでした。
For Nextの書き方が違っているのか、それとも他も含めて問題があるのかが不明です。よろしくお願いいたします。
”Data"シート
Private Sub CommandButton3_Click() ActiveCell.FormulaR1C1 = "みかん" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=1, Criteria1:="みかん" Sheets("Data").Select Range("B2").Select ActiveCell.FormulaR1C1 = "S" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=2, Criteria1:="S" Sheets("Data").Select Range("C2").Select ActiveCell.FormulaR1C1 = "A" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=3, Criteria1:="A" Sheets("Data").Select Range("D2").Select ActiveCell.FormulaR1C1 = "120" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=4 Sheets("Data").Select Range("E2").Select ActiveCell.FormulaR1C1 = "10" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=5, Criteria1:="10" Sheets("Data").Select Range("F2").Select ActiveCell.FormulaR1C1 = "1200" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=6 Range("A2:AB185").Select Selection.Copy Sheets("Sheet2").Select Range("A2").Select ActiveSheet.Paste Sheets("Data").Select Range("A3").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "りんご" Sheets("Sheet1").Select ActiveWindow.ScrollColumn = 11 ActiveWindow.ScrollColumn = 10 ActiveWindow.ScrollColumn = 9 ActiveWindow.ScrollColumn = 8 ActiveWindow.ScrollColumn = 7 ActiveWindow.ScrollColumn = 6 ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Rows("1:1").Select Selection.AutoFilter Selection.AutoFilter ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=1, Criteria1:="りんご" Sheets("Data").Select Range("B3").Select ActiveCell.FormulaR1C1 = "M" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=2, Criteria1:="M" Sheets("Data").Select Range("C3").Select ActiveCell.FormulaR1C1 = "B" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=3, Criteria1:="B" Sheets("Data").Select Range("D3").Select ActiveCell.FormulaR1C1 = "130" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=4, Criteria1:="130" Sheets("Data").Select Range("E3").Select ActiveCell.FormulaR1C1 = "20" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=5, Criteria1:="20" Sheets("Data").Select Range("F3").Select ActiveCell.FormulaR1C1 = "2600" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=6 Range("A3:AB6").Select Selection.Copy Sheets("Sheet2").Select Range("A15").Select ActiveSheet.Paste Sheets("Data").Select Range("A4").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "バナナ" Sheets("Sheet1").Select Rows("1:1").Select Range("L1").Activate Selection.AutoFilter Selection.AutoFilter ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=1, Criteria1:="バナナ" Sheets("Data").Select Range("B4").Select Selection.Copy Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=2, Criteria1:="L" Sheets("Data").Select Range("C4").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "C" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=3, Criteria1:="C" Sheets("Data").Select Range("D4").Select ActiveCell.FormulaR1C1 = "140" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=4 Sheets("Data").Select Range("E4").Select ActiveCell.FormulaR1C1 = "30" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=5 Sheets("Data").Select Range("F4").Select ActiveCell.FormulaR1C1 = "4200" Sheets("Sheet1").Select ActiveSheet.Range("$A$1:$AB$195").AutoFilter Field:=6 Range("A4:AB195").Select Selection.Copy Sheets("Sheet2").Select Range("A17").Select ActiveSheet.Paste End Sub
Dim Kw As の行で構文エラーになり、コード自体実行できないはずです。
実際のコードをコピーして貼り付けてください。
実際のものと違うものを見せられても間違いは指摘できません。
ご連絡ありがとうございます。確かにDim Kw Asのところが記載ミスしていました。ご指摘ありがとうございます。
また、一から作り直してみたのですが、Dataシートに抽出した２行目のデータはフィールターして、Sheet2に貼り付けができたのですが、やはり３行目のデータは何も検索してくれませんでした。
回答3件
0
ベストアンサー
おかしいと思える部分にコメントを入れておきました。
vba
1Private Sub CommandButton3_Click() 2 Dim kk As Integer 3 Dim dd As Variant 4 Dim Kw(7) As Variant 5 6 With Worksheets("Data") 7 maxRow = .Range("A" & Rows.Count).End(xlUp).Row '※Rangeの前に.が必要 8 Debug.Print (maxRow) 9 10 '検索 11 For kk = 1 To 6 12 For dd = 2 To maxRow 13 14 Kw(kk) = .Cells(dd, kk).Value '※Kw(kk)に繰り返し上書きしているだけの無意味な処理 15 Debug.Print "Kw(" & kk & "):" & Kw(kk) 16 Next 17 Next 18 End With 19 20 21 With Worksheets("Sheet1").Range("A1") 22 .AutoFilter 'AutoFilter解除 23 .AutoFilter 1, Kw(1) 24 .AutoFilter 2, Kw(2) 25 .AutoFilter 3, Kw(3) 26 27 End With 28 29 '必要情報のみ"Sheet2"にコピー 30 '抽出データの最終行を求める 31 myRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row '※求めた最終行を使用していない 32 '抽出データをコピーして貼り付け 33 With Sheets("Sheet1").Range("A1") 34 .CurrentRegion.Copy Sheets("Sheet2").Range("A1") 35 End With 36 37 Worksheets("Sheet1").Range("A1").AutoFilter 38 Worksheets("Sheet2").Activate 39 Range("A1").Select 40 End Sub
結局、無意味な部分が多すぎてコードを見ただけでは何をしたいのか把握できません。
言葉で、何をしたいのかを詳細に説明してもらえますか。
提示された情報から最大限推測して、下記のような仕様だと仮定したコード例を提示しておきます。
仕様
"Data”シートに1行毎にフィルタ条件が記述してある
このフィルタ条件で"Sheet1"シートのデータにフィルターをかけて、それを"Sheet2"に順次追加コピーしていく。
コード例
vba
1Private Sub CommandButton3_Click() 2 Dim MotoRng As Range 3 Set MotoRng = Worksheets("Sheet1").Range("A1") 4 5 With Worksheets("Data") 6 Dim maxRow As Long 7 maxRow = .Range("A" & Rows.Count).End(xlUp).Row 8 '"Data"の2行目から順にループ処理 9 Dim rw As Long, cl As long 10 For rw = 2 To MaxRow 11 MotoRng.AutoFilter 'AutoFilter解除 12 '1列目から6列目までを条件にフィルターをかける 13 For cl = 1 To 6 14 MotoRng.AutoFilter cl, .Cells(rw, cl).Value 15 Next 16 'フィルターをかけた"Sheet1"のデータを"Sheet2"に追加コピーする 17 With Worksheets("Sheet2") 18 Dim Sheet2MaxRow As Long 19 Sheet2MaxRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 20 MotoRng.CurrentRegion.Copy .Range("A" & Sheet2MaxRow) 21 End With 22 Next 23 End With 24 25 MotoRng.AutoFilter 'AutoFilter解除 26 27End Sub
テキストエディタ直書きなので動作確認してませんので、おかしなところがあるかも知れません。ロジックを参考にしてください。
投稿2020/05/27 08:00
編集2020/05/28 12:42総合スコア34075
質問と内容がややこしくなってしますみません。
Sheet1に元データがあり、A列からAC列まであります。
Dataシートに今回抽出したいデータがA列からF列、１行目が見出しで２行目からデータがあります。
Dataシートの２行目のセル、"A2"セル＝Kw(1)として、"B2"＝Kw(2)、"C2"=Kw(3),"D2"=Kw(4),"E2"＝Kw(5),"F2"=Kw(6)
その抽出結果をSheet２に貼り付けます。
オートフィルターをかけたいキーワードが６つあります。
次に３行目に抽出したデータを”A3”セル=Kw(1),”B3”セル=Kw(2)・・としてSheet1をオートフィルターをかけてデータを抽出しようとしていました。
どのような条件でフィルターをかけたいのかその説明では伝わりません。
質問に「手動でやりますとおよそ10行くらい抽出されます。」とありますが、それは正しく抽出されてますか。だとしたら、それを「マクロの記録」で記録して、できたマクロのコードを質問に追記してもらえますか。
マクロの記録を行い、コードを貼り付けました。こんな感じなのですが、伝わるといいのですが。
消した以前のコードはもう一度表示させてください。マクロの記録のコードと両方必要です。
できれば、どのようにフィルターをかけたかを、言葉で説明できませんか。
また、"Sheet1"の元データの画像(一部でいいので)もアップしてもらえますか。
ここまで細かくコードを書いて頂きありがとうございました。
記載いただきましたコードを参考に進めていきたいと思います。
アドバイスしていただき本当に感謝しています。
コードを書いていて自己解決できないことがありますのでこれからも勉強してきます。
0
Kw(k_no) = .Cells(d_no, k_no).Value
ここでデバックとなり、色々と試してみましたがうまくいきません。
VBEの画面で上記センテンスが背景黄色で実行停止したということでは？
もしそうなら、F8（ステップイン）押すと何かしらエラーメッセージが表示されませんか？
それと、提示されたVBAコードってコンパイルは通るのですか？
念のためコピペしてコンパイルしたらエラーになりましたよ。
VBA
1Private Sub CommandButton1_Click() 2Dim Kw As 3 Dim k_no As Long 'A列からF列 4
2行目のDim Kw As
As の後ろがないです。（コンパイル前にわかりましたが、、、）
投稿2020/05/27 06:11
総合スコア1095
0
エラー箇所はわかりました、エラー内容を教えて下さい。
投稿2020/05/26 13:30
総合スコア107
説明が不足して申し訳ありません。追記いたしました。
もし不足がございましたら、コメントをください。
どうぞよろしくお願いいたします。
つまりエラーは出ておらず、思った通りにいっていないだけだという理解でよろしいですか？
その上で気になるのは、まず最終行が取得できているのかという点です。
Debug.Print (maxRow)
この部分は、デバックウインドウに結果として出力さらるので意図した値が取得できているか確認しましょう。
また
Debug.Print "Kw(" & k_no & "):" & Kw(k_no)
の部分でも同様です。
やりたい事を実現させてくれというのではなく、プログラムのどの部分でどんな結果を得たいのにできないのかを示しましょう。
あなたの回答
tips
プレビュー
