• ベストアンサー

For~Nextについて

papayukaの回答

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.3

#1です。 > これは If文です。 > 条件が合わないので Exit Sub に入り、そのまま何もしないで終了です。 すみません、勘違いでした。 何も起きない理由は「条件が合わない場合の記述がない」ためです。 If を使うなら  If myTbl.Cells(i, myFld).Value = AB Then    Exit Sub  Else    myTbl.Cells(i, myFld).Value = AB  End If のように Else で条件が一致しない場合の処理をいれるか、  If myTbl.Cells(i, myFld).Value <> AB Then   myTbl.Cells(i, myFld).Value = AB  End If のように条件が一致しない場合に処理するようにするかです。

関連するQ&A

  • 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 以上教えてください。 お願いします。

  • For~Nextの使い方

    こんにちは Range("B19").Value = Application.WorksheetFunction.Sum(Range("B4:B17")) Range("B55").Value = Application.WorksheetFunction.Sum(Range("B40:B53")) Range("B91").Value = Application.WorksheetFunction.Sum(Range("B76:B89")) Range("B127").Value = Application.WorksheetFunction.Sum(Range("B112:B125")) 上記を参考書等で見ながらやって見たのですが 動作しません。 For~Nextの使い方を教えて下さい。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim x As Long, g As Long For x = 19 To 127 Step 36 For g = 4 To 112 Step 36 Cells(x, "B").Value = Application.WorksheetFunction.Sum(Cells(g, "B")) Exit For Next Next End Sub

  • マクロ 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

  • エクセルのデータの変更

    今マクロでSheet1にあるデーターをSheet2・3・4・5・6・7それぞれにそれぞれの抽出条件で抽出できるよう設定してあるのですが、このSheet1を他のBookに変更した場合のマクロの変更の仕方を教えてください。 ちなみにいまは 標準モジュールに Sub 定義() Dim myTbl As Range, myQry As Range, sakiRng As Range End Sub と各シートの[Worksheet Activate] に Private Sub Worksheet_Activate() Set myTbl = Sheets(1).Range("myTbl") Set myQry = Sheets(8).Range("A_抽出条件") Set sakiRng = Sheets(2).Range("A3:AR3") myTbl.AdvancedFilter xlFilterCopy, myQry, sakiRng Dim rw As Long '入力最終行 rw = Range("I65536").End(xlUp).Row With Application Range("I" & rw + 1) = .Sum(Range("I1:I" & rw)) Range("AO" & rw + 1) = .SumIf(Range("AP1:AP" & rw), "済", Range("AO1:AO" & rw)) Range("AQ" & rw + 1) = .Sum(Range("AQ1:AQ" & rw)) End With 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 セル

  • 他Bookへの抽出

    お世話になります。 開いているBook1からデータを抽出し、Book2へコピーしたいのですが、AdvancedFilterでエラーが出てしまいます。 何がまずいのかよくわかりません。 お分かりになる方、ご教授願います。 Private Sub Worksheet_Activate() Set myTbl = Workbooks("Book1.xls").Worksheets("Sheet1").Range("myTbl") Set myQry = Workbooks("Book2.xls").Worksheets("抽出条件").Range("A_抽出条件") Set sakiRng = Workbooks("Book2.xls").Worksheets("A").Range("A3:AR3") myTbl.AdvancedFilter xlFilterCopy, myQry, sakiRng ←ここでエラーになります。 Dim rw As Long '入力最終行 rw = Range("I65536").End(xlUp).Row With Application Range("I" & rw + 1) = .Sum(Range("I1:I" & rw)) Range("AO" & rw + 1) = .SumIf(Range("AP1:AP" & rw), "済", Range("AO1:AO" & rw)) Range("AQ" & rw + 1) = .Sum(Range("AQ1:AQ" & rw)) End With End Sub

  • EXcel VBAのFor~Nextステートメントで質問です

    初歩の初歩ですがお願いします。 3から13行目をデータのある最終行の下に 20回コピーをしていきたいのですが、 (3から13行のデータの複製を20個用意 したいということです) つまずいています。iとしてみたのですが 、何をiとして実行させるのか分かりません。 教えていただけないでしょうか? Sub test() Dim i As Integer For i = ● To ●   Rows("3:13").Copy   Worksheets("Sheet1").Range("A65536") _   .End(xlUp).Offset(1).Select   ActiveSheet.Paste  Application.CutCopyMode = False   Next i    End Sub

  • VBA マクロ シート 転記

    はじめまして。VBA初心者です。今シート1のA列1行目セルにA社、A列2行目にB社、A列3行目にC社と・・ざっと1000行程あり、それぞれB列には値があります。この値をシート2のB列に転記したいと思っています。ただ、毎月シートを追加していきますので、左隣のシートから転記しなければなりません。シート2の項目は同じA列とB列で構成されています。A列の値が多少前後するので、FINDを使って以下のようなプログラムを作りました。ただ、左隣のシートから転記とう内容をどうやって追加したら良いのかがわかりません。Previous をどこかに使えばできるのかなとも思うのですが、その方法がわかりません。 Sub 転記() Dim ws As Worksheet, ws1 As Worksheet, r As Range, r1 As Range Dim LastRow As Long, i As Long, er As Long, wkey As String Set ws = Worksheets("Sheet1") Set ws1 = Worksheets("Sheet2") LastRow = ws.Range("A1").End(xlDown).Row er = ws1.Range("A1").End(xlDown).Row Set r = ws.Range("A1:A" & LastRow) For i = 1 To er wkey = ws1.Range("A" & i) Set r1 = r.Find(What:=wkey, LookIn:=xlValues, LookAt:=xlWhole) If Not r1 Is Nothing Then ws1.Range("B" & i) = r1.Offset(, 1) End If Next Set r1 = Nothing Set r = Nothing Set ws = Nothing Set ws1 = Nothing End Sub どなたか詳しいお方いらっしゃいましたら、初心者の私に教えて頂けませんでしょうか?宜しくお願いします。

  • VBA Next For でのコピペについて

    EXCEL VBA初心者です。 AシートEW44からGD44までをコピーしてBというシートの最終行へコピーしたいです。 今下記のように組んでいるのですが、うまく作動しません。 Private Sub CommandButton1_Click() Dim i As Integer For i = 153 To 186 row1 = Worksheets("B").Cells(Rows.Count, 27).End(xlUp).Row Worksheets("A").Cells(i, 44).Value = Worksheets("B").Cells(row1 + 1, 27).Value Next i End Sub アドバイスいただけませんでしょうか。

  • 転記したデータを基にして検索表示させる方法

    下記のようにシートAのデータをシートB(A列)へ転記した後に、転記したデータを基にしてデータベースから検索した結果をシートB(B列)に表示したいのですが、マクロを実行すると「型が一致しません」というエラーになります。 どのようにしたらエラーにならないのか… どうぞよろしくお願いします。 Sub レコード転記() Dim myTbl As Range, sakiRng As Range Set myTbl = Sheets("A").Range("B6:B81") Set sakiRng = Sheets("B").Range("A5") myTbl.Copy sakiRng.PasteSpecial xlPasteAll sakiRng.PasteSpecial xlPasteColumnWidths End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Variant, myRange As Range Set myRange = Workbooks("入力フォーム.xls").Worksheets("一覧表").Range("社名") With Target If Target.Column = 1 Then r = Application.WorksheetFunction _ .Match(Target.Value, myRange, 0) Cells(Target.Row, 2) = Workbooks("入力フォーム.xls").Worksheets("一覧表").Range("N1").Offset(r - 1).Value End If End With End Sub