- ベストアンサー
For Next構文についての質問
chie65535の回答
- chie65535
- ベストアンサー率43% (8525/19380)
重大な間違いがあります。 For ビスケット = 2 To Range("A2").End(xlDown).Row のFor～Nextは「オートフィルタを無視して、常に、2、3、4、5、6、7...…と増えていく」のです。 つまり「オートフィルタ関係なしに、F列の値がどうなってようが関係なしに、C列に何か入っている行に、上から順に連番を振っていく」と言う動作になってしまっています。 ですので、オートフィルタを設定しても無駄です。オートフィルタは外しましょう。 あと、 For ビスケット = 2 To Range("A2").End(xlDown).Row のForは「A列に連番を１つでもセットすると、終了値が表の最後の行番号にならない」ので、値を１つでも入れれば、Forループが途中で止まります。 このFor文が「2行目から最終行まで」の意味であるならば、F列の一番最後の行を「最終行」としてマクロを組む必要があります。 F列が「途中に空白セルが無い状態でミッチリと0～5のデータが埋まっている状態」なら For ビスケット = 2 To Range("F2").End(xlDown).Row でも構いませんが、途中に空白セルがあったりすると、やはり「最終行の手前」で止まってしまいます。 「2行目から最終行まで」をループする場合は For ビスケット = 2 To Cells(Rows.Count, 6).End(xlUp).Row でループします。 上記を踏まえて修正すると、以下のようになります。 Sub Macro1() Dim マシュマロ As Integer Dim 和菓子 As Integer Dim ビスケット As Long 'もしオートフィルタが設定してあったら If ActiveSheet.AutoFilterMode Then 'オートフィルタを解除する Range("A:AG").AutoFilter End If For マシュマロ = 0 To 5 和菓子 = 1 '2行目～F列の最終行までループ For ビスケット = 2 To Cells(Rows.Count, 6).End(xlUp).Row 'F列がマシュマロと一致し、かつ、C列に何かあれば If Cells(ビスケット, 6) = マシュマロ And Cells(ビスケット, 3) <> "" Then Cells(ビスケット, 1) = 和菓子 和菓子 = 和菓子 + 1 End If Next ビスケット Next マシュマロ End Sub
関連するQ&A
- マクロ for～next うまくいかない
シート内の値を並び替えて、別シートに貼り付けるコード作成中。 ①偶数行の値を奇数行の特定の列に貼り付け、元の値は消す ②(2)と書かれたセルがある場合、その行をコピーして同一行に挿入し、(2)の値は消す この2つが機能しません。 ほか部分は動きます。 これが機能しない原因、分かるでしょうか。 以下、コード Private Sub CommandButton6_Click() Dim i As Long For i = 1 To 9 If Me.Controls("TextBox" & CStr(i)).Value = "" Then 'ユーザーフォーム内のテキスト1～9で空欄があると以下の操作 MsgBox Me.Controls("Label" & CStr(i)).Caption & " が未記入です" '空欄があると、ラベル名＋が未記入ですのメッセージ後、処理終了 Exit Sub End If Next Dim Convert_book As String, GC_book As String, GC_address As String Convert_book = TextBox8.Value '変換シートのブック名を取得 GC_book = TextBox7.Value 'ブックAの名前を取得 GC_address = TextBox6.Value 'ブックAの保存先を取得 With Workbooks(GC_book).Worksheets(ws_name) 'ブックAシート1をWithとする。 .Range("A1:CZ200").UnMerge 'ブックAシート1の結合を解く '部品番号と客先コードをコピー .Range(Cells(Range(Parts_no).Row, Range(Parts_no).Column), _ Cells(Range(Parts_no).Row + 1, Range(Parts_no).Column)).Copy '変換シートに貼付けWorkbooks(Convert_book).Worksheets(1).Range("G4").PasteSpecial Paste:=xlPasteValues '管理№をコピー、変換シートに貼付け .Range(Control_no).Copy Workbooks(Convert_book).Worksheets(1).Range("AJ2").PasteSpecial Paste:=xlPasteValues Dim r As Long, r1 As Long, c As Long, c1 As Long, c2 As Long, c3 As Long '管理№の行と列を取得 r = .Range(Control_no).Row c = .Range(Control_no).Column '材料関連の情報のコピーと貼付け .Range(.Cells(r + 2, c - 4), .Cells(r + 3, Last_column - 1)).Copy Workbooks(Convert_book).Worksheets(1).Range("AF4").PasteSpecial Paste:=xlPasteValues '変数に、加工工程№の行と列を入れる。変更年月日の行、測定具の列、管理№の列も入れる。 r = .Range(Process_no).Row '可変 r1 = .Range(Rev_no).Row '可変 c = .Range(Process_no).Column '32または33列目 c1 = .Range(Tool_name).Column '27または28列目 c2 = Last_column '44または43列目 c3 = .Range(Control_no).Column '通常1列目 .Range(Cells(r, c2), Cells(r1 - 2, c2)).Clear '最終列をすべてクリア Dim k As Long, j As Long k = 1 '最終列に1、2、1、……繰返し数を入れる For i = r To r1 - 2 If k = 1 Then .Cells(i, c2).Value = 1 k = k + 1 Else .Cells(i, c2).Value = 2 k = k - 1 End If Next Dim i1 As Long, k1 As Long, j1 As Long k1 = 1 '管理値の欄で偶数列の値を奇数列に移す For i1 = r To r1 - 2 If .Cells(i1, c2).Value = 2 Then For j1 = c3 + 18 To c1 - 1 If .Cells(i1, j1).Value <> "" Then .Cells(i1 - 1, c3 + 25) = .Cells(i1, j1).Value .Cells(i1, j1).Value = "" End If Next j1 End If Next i1 Dim i2 As Long, k2 As Long, j2 As Long k2 = 1 '"(2)"と書いてある行を2行に増やして、"(2)"を消す For i2 = r To r1 - 2 If .Cells(i2, c2).Value = 1 Then For j2 = c3 + 18 To c1 - 1 If .Cells(i2, j2).Value Like "*(2)*" Then .Cells(i2, j2).Formula = Replace(Cells(i2, j2).Formula, "(2)", "") .Range(Cells(i2, 1), Cells(i2, c2)).Copy .Range(Cells(i2, 1), Cells(i2, c2)).Insert xlShiftToRight End If Next j2 End If Next i2 '最終列の番号順に並べる .Range(Cells(r, 1), Cells(r1 - 2, c2)).Sort _ key1:=Cells(r, c2), order1:=xlAscending End With ～～(この間はまだ未作成)～～ Application.DisplayAlerts = False Workbooks(GC_book).Close SaveChanges:=False Application.DisplayAlerts = True End Sub
- ベストアンサー
- Excel（エクセル）
- VBA For～Next
こんにちは 上手く 説明できるか心配なのですが 下記のテスト１ですと 36行毎に Targetが A4,A40,A76,A112だと A1,A437,A73,A109.Value = "" Then ComboBox3.DropDownさせてから ComboBox4.DropDownさせてますが A1,A437,A73,A109にValue が入っていると A4,A40,A76,A112のCellをActiveしても ComboBox4.DropDown しません。 そこで、テスト２のように For～Nextを二つに分けました。 テスト２の方法しか無いのでしょうか？ 宜しくお願いします。 Dim Row As Long 'テスト１ For Row = 4 To 112 Step 36 If Not Intersect(Target, Cells(Row, "A")) Is Nothing Then '今日の日付DropDown If Cells(Row - 3, "A").Value = "" Then form.ComboBox3.DropDown ElseIf Not Intersect(Target, Range(Cells(Row, "A"), Cells(Row + 13, "A"))) Is Nothing Then 'A列日付 form.ComboBox4.DropDown End If Next Dim Row As Long, iRow As Long 'テスト２ For Row = 4 To 112 Step 36 If Not Intersect(Target, Cells(Row, "A")) Is Nothing Then '今日の日付DropDown If Cells(Row - 3, "A").Value = "" Then form.ComboBox3.DropDown End If Next For iRow = 4 To 112 Step 36 If Not Intersect(Target, Range(Cells(iRow, "A"), Cells(iRow + 13, "A"))) Is Nothing Then 'A列日付 form.ComboBox4.DropDown End If Next
- ベストアンサー
- オフィス系ソフト
- For～Nextについて
VBA勉強中です。 For～Nextについて、いまいちわからないので、教えてほしいのですが、 下記の表を作り、テーブルと言う名前を付けました。 Ｃ列に上からＡ．Ｂの値を入れようと思います。 | Ａ | Ｂ |Ｃ 1| ＡＡ| １１| 2| ＡＢ| １２| Sub Macro1() Dim AA As Range, BB As Range, AB As Variant Dim myTbl As Range, myFld As Integer, i As Integer Set AA = Range("A1") 'AAの箱にA1の値を Set BB = Range("B1") 'BBの箱にB1の値を Set myTbl = Range("テーブル") 'myTblの箱にテーブルを myFld = 3 'myFldの箱に3列目 AB = AA & "." & BB 'A1とB1の値を入れる For i = 1 To myTbl.Rows.Count 'iはテーブルの1行目から最後の行まで If myTbl.Cells(i, myFld).Value = AB Then 'テーブルの1行目のCのセルにA1とB1の値を入れる Exit Sub End If Next End Sub と思うのですが、やはり動きません。 アドバイスをお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel マクロのFor～Nextで再起動エラー
勤務表を作っています。 下記の’ＯＫまでは希望どうりうまく出来ていたのですが、勤務表の下セルに各列の人員（行）１０名分位Ａ，Ｂ,Cの計を表示させたい。実行するとエラー「Microsoft office Excel 再起動」を求められます。 for～が判断指令が<重い>のでしょうか。なんとか回避さする方法を教えてください。 Win XP Sp2 Office Excel 2007です。今回これを作るにあたり初ＶＢＡ使用者です。 ' C入力後の翌日は休をセット。CC連続は休休セット。 Private Sub Worksheet_Change(ByVal Target As Range) Dim cnt As Variant Dim a1 As Byte Dim b1 As Byte Dim c1 As Byte Dim nin As Variant Dim retsu As Variant If Target.Count > 1 Then Exit Sub '複数セルの入力は無視 'Ａ If Target.Value = "Ａ" Or Target.Value = "A" Then Target.Value = "A" Range("AV16").Value = Target.Column End If 'Ｂ If Target.Value = "Ｂ" Or Target.Value = "B" Then Target.Value = "B" Range("AV16").Value = Target.Column End If 'Ｃ If Target.Value = "Ｃ" Or Target.Value = "C" Then Range("AV16").Value = Target.Column Target.Value = "C" Else End If ' If Target.Value = "C" Then If Target.Offset(0, -1).Value = "C" Then 'Ｃが連続したら Target.Offset(0, 1).Resize(1, 2).Value = ("休") '連休に Else End If Target.Offset(0, 1).Value = ("休") 'そうでなければ休 End If 'A,B,C の数をカウントする。 nin = Range("AV15") '別のプログラムから入力した人員数 retsu = Range("AV16") ' A,B,Cのいずれかを入力したセル列。Target.Column ’OK For cnt = 7 To (6 + nin) If cells(cnt, retsu) = "A" Then a1 = a1 + 1 End If If cells(cnt, retsu) = "B" Then b1 = b1 + 1 End If If cells(cnt, retsu) = "C" Then c1 = c1 + 1 End If Next cnt cells(nin + 7, retsu) = a1 'Ａ番 cells(nin + 8, retsu) = b1 'Ｂ番 cells(nin + 9, retsu) = c1 'Ｃ番 End Sub
- ベストアンサー
- Windows XP
- 【VBA】For Nextなどを使わないコード
こちらの識者の方々にはいつもお世話になっております。 VBAの質問です。 約40000行30列のデータがあるブックが20個あり、処理を毎日やるのですが、 処理自体はとても単純なものの、いかんせんデータ量が膨大で マクロの時間がかかりすぎてしまいます。 現在は下記のようなコードになっています。 Sub test() Dim lRow As Long Dim f As Long Application.ScreenUpdating = 0 Sheets(1).Activate lRow = Cells(Rows.Count, 1).End(xlUp).Row For f = lRow To 2 Step -1 If Cells(f, 4) = Empty Or Cells(f, 3) = "aa" Then Cells(f, 4).EntireRow.Delete Else Cells(f, 2) = Mid$(Cells(f, 1), 4, 2) Cells(f, 3) = Format(Application.VLookup(Cells(f, 3), Sheets(2).Range("A2:C8"), 2, 0), "00") Cells(f, 4) = IIf(Left$(Cells(f, 4), 1) = "Z", Cells(f, 5), Cells(f, 4)) Cells(f, 7) = Format(Cells(f, 7), "yyyy/mm/dd") Cells(f, 11) = Cells(f, 2) & Cells(f, 3) Cells(f, 12) = Cells(f, 7) End If Next f Application.ScreenUpdating = 1 MsgBox "done" End sub 最初の行削除についてはオートフィルタで処理するとして、for NextやFor Eachなどの1行ずつ処理するコードを使わず、一気に処理することはできないのでしょうか？ せめて Cells(f, 11) = Cells(f, 2) & Cells(f, 3) ぐらいは Range("K2:K40000") = Range("B2:B40000") & Range("C2:C40000") みたいな記述ができないものかなぁと思っています。 このようなことは可能でしょうか？
- ベストアンサー
- その他MS Office製品
- VBAでのfor文について
5行のデータがあるとして、先頭の文字がaで始まる行を削除して 上に詰めたいと考えています。 しかし、Range("i:i")のところに可変の数字iをうまく指定できて いないようで、うまく実行されません。 どこがまずいのでしょうか？ Sub sample() Dim i As Integer For i = 1 To 5 activeworksheet.Cells(i, 2) = Mid(Cells(i, 1), 1, 1) If Cells(i, 2) = "a" Then ActiveSheet.Range("i:i").Delete shift:=xlshiftUp End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- エラー"Next"に対する"for"がありません
EXCELのVBAで、A列3行目から入力されているデータ（A列2行目タイトル="FA"）を 一度全て半角に変換し、変換した"変換文字"から"!"や"#"の記号をASC関数を利用し 削除、記号だけを削除した文字列をE列に取得しようとしていますが NEXTにたいするFORがありませんとエラーが出てしまいます。 TARGETの設定の仕方が悪いのでしょうか？ （win7/EXCEL2010使用） Dim セル As Range Dim TARGET As Range Dim 変換文字 As String Dim i As Long Dim W As Worksheet Set W = Sheets("DATA転記") Set TARGET = W.Range("A3", Range("A65536").End(xlUp)) For Each セル In TARGET 変換文字 = StrConv(セル.Text, vbNarrow) For i = 1 To Len(変換文字) If Asc(変換文字) >= 32 And Asc(変換文字) <= 47 And _ Asc(変換文字) >= 58 And Asc(変換文字) <= 64 And _ Asc(変換文字) >= 91 And Asc(変換文字) <= 96 And _ Asc(変換文字) >= 123 And Asc(変換文字) <= 126 Then _ 変換文字 = WorksheetFunction.Replace(変換文字, i, 1, "") Next i セル.Cells(, 5).Value = 変換文字 Next セル
- ベストアンサー
- オフィス系ソフト
- For～Next ループ内でUnionメソッドを使うとエラーになります。
下記の記述で2行おきのセル範囲から0以下のセルを除外したセル範囲を取得しようとすると Set Rng = Application.Union(r, Rng) の行でエラーが発生します。 'Set Rng = Range(Cells(12, 7), Cells(12, 7)) の行のコメントアウトをはずすと動きますが、 cells(12,7)の値が0以下だと本来の目的 である0以下のセル範囲を除外するという目的が果たせません。 Union(r,Rng)のRngがnothingになっているとエラーの原因になるのでしょうか？ Private Sub test() Dim r As Range Dim Rng As Range 'Set Rng = Range(Cells(12, 7), Cells(12, 7)) For i = 12 To 27 Step 3 If Cells(i, 7) > 0 Then Set r = Range(Cells(i, 7), Cells(i, 7)) Set Rng = Application.Union(r, Rng) End If Next i Rng.Select End Sub 以上教えてください。 お願いします。
- ベストアンサー
- Visual Basic
- IFの構文で
IF の構文を作っていますが Cells(p, 6) がブランクのとき何もしない Cells(p, 6)＜＝ If Cells(p, 7) とき何もしない Cells(p, 6)＜ If Cells(p, 7) とき その列を削除する という文にしたいのですがうまくできません 自分なりに以下つくったのですが.... お教えいただければと思い投稿しました、どうぞよろしくお願いします。 Sub 削除() Dim p As Long Sheets("前Ｐ").Select For p = 200 To 7 Step -1 ’なにもしないで次の処理へ行く ここがうまくいかない If Cells(p, 6) = " " Then ElseIf Cells(p, 6) < Cells(p, 7) Then Range(Cells(p, 2), Cells(p, 20)).Select Selection.Delete Shift:=xlUp End If Next p End Sub うまくいかないのは上記の構文だとブランクも削除の対象と なってしまうところです。 うまくブランクは残して実行する方法を教えていただきたいのですがよろしくお願いいたします。 .
- 締切済み
- Visual Basic
- Excel VBA For Each Next構文内の別シートを対象とする方法
こんにちは。 ＶＢＡ初心者のものですが教えてください。 「sheet1のC29:U29とsheet2のC31:G31について 1より小さければ小数第2位まで表示する」 の構文を作成したいのですが、 下記の構文ではエラーが出てしまいました。 どのように訂正すればよいでしょうか？ ※できればrangeプロパティを使いたいのですが、 cellsプロパティを使わなきゃできませんか？ すみませんがご教示をお願いいたします。 Sub test() Dim myrange As Range For Each myrange In Worksheets("sheet1").Range("C29:U29"),Worksheets("sheet2").Range("C31:G31") If myrange.Value < 1 Then myrange.NumberFormatLocal = "0.00" End If Next myrange End Sub
- ベストアンサー
- オフィス系ソフト
お礼
chie65535さんご回答いただいてありがとうございます！確かに、手動でやってみてもオートフィルタをかけたまま配番してもうまくいきません！(>_<)データがみっちり詰まっているので、End(xlDown)でもいいのかなぁ～と思ったのですが、空白ができた場合も考えてEnd(xlUp)のほうが確かによいかもしれないですね！(^O^)