- ベストアンサー
For Next構文についての質問
tsubu-yukiの回答
- tsubu-yuki
- ベストアンサー率46% (179/386)
ＶＢＡ学習中、でしょうか？ ま、色々な考え方ができるよ、という参考までに。 ちょっと質問文の日本語が難解で正確に読み取れているか自信薄ですが、 要するに「Ｆ列の値ごとに連番を振り、Ａ列に入力」という事でしょうか。 違ったらスルーの方向で。 ご提示のコードで危険だなぁと思うのが > For ビスケット = 2 To Range("A2").End(xlDown).Row ここ。 今、やりたいのは「Ａ列に値を入力」なので、 > A列は空白です。 の記述の通りＡ列に現状は「何も入っていない」とすると、 エクセルが許す全行（１０４８５７６行目）まで繰り返してしまいます。 これはなんとなく処理時間的にもうまくないはず。 「Ｆ列の値を基にした連番」を振るのなら、このキーはＦ列の方が良いかと。 で、途中に空白を噛んでいたりする事故を防ぐために、 有効な最終行を「下から上に」探してやります。 つまり、 Cells(Rows.count, 6).End(xlUp).Row で最終行を取る方が良いと個人的には思います。 続いて、フィルタの部分。 既に出ていますが、フィルタは「隠れている」だけで セルとしてはワークシートに「存在している」ので、 こういう処理（条件で連番を振る）には不向きかもしれません。 条件に合わない行はスルー、の方が効率は良さそうです。 伴ってもう一つ、変数「スパゲティ」はどうやら 「フィルタで見つけた（Ｃ列における）最終行」としてお使いのようです。 コレをキーにして連番をリセットしているように見えますが、 フィルタを使わないのであればコレも不要です。 「Ｆ列の値（０～５）ごとの連番」なのですから、 変数「マシュマロ」が変わるタイミングでリセットしてやる方が解り易いです。 ・・・というか、そもそもそう書いていらっしゃるようですので そもそも不要だった、と言えますね。 そんなこんなで、私が書き変えるなら Dim マシュマロ As Integer Dim 和菓子 As Long Dim ビスケット As Long Dim 最終行 As Long ' 最終行取得（Ｆ列） 最終行 = Cells(Rows.Count, 6).End(xlUp).Row For マシュマロ = 0 To 5 和菓子 = 1 ' 連番リセット For ビスケット = 2 To 最終行 ' Ｃ列が空白じゃなく、且つ、Ｆ列が「マシュマロ」と合致したら If Cells(ビスケット, 3) <> "" And Cells(ビスケット, 6) = マシュマロ Then Cells(ビスケット, 1) = 和菓子 ' 連番を入力 和菓子 = 和菓子 + 1 ' 連番を更新 End If Next ビスケット Next マシュマロ こんな感じでシンプルに書きたいなぁ、 ・・・と思ったら、１番さんとほぼ一緒でしたね。 失礼しました。 以下、余談です。 この案件、ＶＢＡを使わずに考えたらどうなるでしょう？ 実はこっちの方が簡単ですが、おなじみの関数 Ａ２セル：=COUNTIF($F$2:F2,F2) 以下、必要分フィル。 COUNTIFで実現可能です。 WorksheetFunction.関数（・・・）で 大半のワークシート関数をＶＢＡ内で同様に使えます。 割と便利です、というか、エクセルなのだから使わないと損です。 否定的なご意見が多いのも事実ですが(笑)。 ですが、コレを使うのも手の一つです。 例えば（１行が長いですが）For～Nextを使って For i = 2 To Cells(Rows.Count, 6).End(xlUp).Row Cells(i, 1) = WorksheetFunction.CountIf(Range(Cells(2, 6), Cells(i, 6)), Cells(i, 6)) Next こんな感じで書けます。 処理数が数万行の単位まで膨らむのであれば、For～Nextで回すより遥かに早く終わります。 セルに式が残ってもいいのであれば、R1C1形式を使って Range("A2:A" & 最終行).FormulaR1C1 = "=COUNTIF(R2C6:RC[5],RC[5])" こんな感じでさらにシンプルに書けます。 で、コレに「セルに式を残したくない（値だけ残したい）」のであれば With Range("A2:A" & Cells(Rows.Count, 6).End(xlUp).Row) 'この範囲について .FormulaR1C1 = "=COUNTIF(R2C6:RC[5],RC[5])" '式を入力 .Copy ' コピー .PasteSpecial Paste:=xlPasteValues ' 数値のみ貼り付け End With Application.CutCopyMode = False 'コピーモード解除 こんな感じです。 数万行でも（ＶＢＡの処理は）一瞬で終わります。 コレだと「エクセルの一般機能に依存した処理」ですから、 処理速度は一番早いです。 ※前記、WorksheetFunctionはＶＢＡ依存の処理 且つFor～Nextで回すので、ほんのわずかに遅れます。 私ならおそらくコレを採用するかな。 否定的なご意見もあるかもしれませんけどね(笑)。
関連する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
- ベストアンサー
- オフィス系ソフト
お礼
WorkSheetFunction・・・！そんなものがあるとは知らなかったです！ しかも、関数と同じ記述方法なので、結構わかりやすいですね！目から鱗です・・ありがとうございます！(^O^)