質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

3回答

2285閲覧

VBA 行数だけ繰り返す

koko2

総合スコア21

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/05/26 12:38

編集2020/05/28 10:01

<やりたいこと>
・"Sheet1"に元データがあります。"Data"シートに抽出シートしたデータがあり、毎回行数が変わります。
・Dataシートの行数分、抽出を繰り返します。今回ですと3回になります。
・抽出結果を"Sheet2"に貼り付けます。
・抽出結果は1行ごとにひとかたまりで、Sheet1でフィルターをかけます。手動でやりますとおよそ10行くらい抽出されます。ですので、Sheet2は30行くらいになります。

<エラー内容>
”Data”シートの2行目のデータしか検索されず、他の3行目、4行目は検索されませんでした。
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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hatena19

2020/05/27 00:50

Dim Kw As の行で構文エラーになりコード自体実行できないと思いますが。 実際のコードをコピーして貼り付けください。でないと間違いの指摘はできません。
hatena19

2020/05/27 01:00

Dim Kw As の行で構文エラーになり、コード自体実行できないはずです。 実際のコードをコピーして貼り付けてください。 実際のものと違うものを見せられても間違いは指摘できません。
koko2

2020/05/27 07:42

ご連絡ありがとうございます。確かにDim Kw Asのところが記載ミスしていました。ご指摘ありがとうございます。 また、一から作り直してみたのですが、Dataシートに抽出した2行目のデータはフィールターして、Sheet2に貼り付けができたのですが、やはり3行目のデータは何も検索してくれませんでした。
guest

回答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
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

koko2

2020/05/27 09:41

質問と内容がややこしくなってしますみません。 Sheet1に元データがあり、A列からAC列まであります。 Dataシートに今回抽出したいデータがA列からF列、1行目が見出しで2行目からデータがあります。 Dataシートの2行目のセル、"A2"セル=Kw(1)として、"B2"=Kw(2)、"C2"=Kw(3),"D2"=Kw(4),"E2"=Kw(5),"F2"=Kw(6) その抽出結果をSheet2に貼り付けます。 オートフィルターをかけたいキーワードが6つあります。 次に3行目に抽出したデータを”A3”セル=Kw(1),”B3”セル=Kw(2)・・としてSheet1をオートフィルターをかけてデータを抽出しようとしていました。
hatena19

2020/05/28 01:24

どのような条件でフィルターをかけたいのかその説明では伝わりません。 質問に「手動でやりますとおよそ10行くらい抽出されます。」とありますが、それは正しく抽出されてますか。だとしたら、それを「マクロの記録」で記録して、できたマクロのコードを質問に追記してもらえますか。
koko2

2020/05/28 10:04

マクロの記録を行い、コードを貼り付けました。こんな感じなのですが、伝わるといいのですが。
hatena19

2020/05/28 11:03

消した以前のコードはもう一度表示させてください。マクロの記録のコードと両方必要です。 できれば、どのようにフィルターをかけたかを、言葉で説明できませんか。 また、"Sheet1"の元データの画像(一部でいいので)もアップしてもらえますか。
koko2

2020/05/28 12:56

ここまで細かくコードを書いて頂きありがとうございました。 記載いただきましたコードを参考に進めていきたいと思います。 アドバイスしていただき本当に感謝しています。 コードを書いていて自己解決できないことがありますのでこれからも勉強してきます。
guest

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

DreamTheater

総合スコア1095

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

koko2

2020/05/27 07:47

回答ありがとうございました。こちらの記載不足でした。ご指摘ありがとうございました。ただ、肝心のところが未解決なので、再度作り直しが必要なようです。
guest

0

エラー箇所はわかりました、エラー内容を教えて下さい。

投稿2020/05/26 13:30

rinren

総合スコア107

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

koko2

2020/05/26 14:11

説明が不足して申し訳ありません。追記いたしました。 もし不足がございましたら、コメントをください。 どうぞよろしくお願いいたします。
rinren

2020/05/26 15:50

つまりエラーは出ておらず、思った通りにいっていないだけだという理解でよろしいですか? その上で気になるのは、まず最終行が取得できているのかという点です。 Debug.Print (maxRow) この部分は、デバックウインドウに結果として出力さらるので意図した値が取得できているか確認しましょう。 また Debug.Print "Kw(" & k_no & "):" & Kw(k_no) の部分でも同様です。 やりたい事を実現させてくれというのではなく、プログラムのどの部分でどんな結果を得たいのにできないのかを示しましょう。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問