- 締切済み
vba
VBAはじめたばかりで、躓きました。 下記を実行すると、”Nextに対するForがありません。”とでます。 なぜこうなるのか教えてください。 G2～列2000の間が空白になるまで、 下記の処理を続けるようにしたいと思っています。 Dim i As Integer For i = 7 To 2000 Do If Cells(2, i) = "" Then Range("G2").End(xlToRight).Select ActiveCell.CurrentRegion.Resize(6, 5).Select Selection.Cut Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste Exit Do End If Next i Loop よろしくお願いします。
- yasushi0715
- お礼率60% (3/5)
- Visual Basic
- 回答数3
- ありがとう数2
- みんなの回答 （3）
- 専門家の回答
みんなの回答
- hallo-2007
- ベストアンサー率41% (888/2115)
”Nextに対するForがありません。”とでます。 なぜこうなるのか教えてください。 に対する回答は出ていますが、 G2～列2000の間が空白になるまで、 下記の処理を続けるようにしたいと思っています。 は大丈夫？ Ｆｏｒ と Ｄｏの二重のループも必要？ For i = 7 To 2000 Step 5 If Cells(2, i) = "" Then Exit For Cells(2, i).Select ActiveCell.CurrentRegion.Resize(6, 5).Select Selection.Cut Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste Next i Cells(2, i).Select ActiveCell.CurrentRegion.Resize(6, 5).Select Selection.Cut も Cells(2, i).CurrentRegion.Resize(6, 5).Cut と１行にまとめたりも出来ます。
関連するQ&A
- vba 対象セルが空白の間動作を繰り返すには？
下記を走らせると、セルが右端まで行ってとまります。 そうなる前に、対象セル範囲が空白になった時点で、動作を止めたいのですが どう記述するのがいいでしょうか？ Dim u As Integer, o As Integer Application.Calculate For u = 2 To 3 For o = 7 To 2000 If Cells(u, o) = "" Then Range("G2").Select Range("G2").End(xlToRight).Select ActiveCell.Resize(6, 5).Select Selection.Cut Range("B2").Select Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste End If Next o Next u End Sub
- ベストアンサー
- Visual Basic
- エクセルxpのVBA
VBA初心者です。下記を実行すると、「elseに対応するifがありません」と出ます。なぜかわからず困っています。 For hiniti = DateSerial(Range("A3"), Range("A4"), 21) To DateAdd("m", 1, DateSerial(Range("A3"), Range("a4"), 20)) ActiveCell.Value = hiniti ActiveCell.Offset(0, 1).Select If ActiveCell.Column = 7 Then ActiveCell.Offset(1, -7).Select Else: ActiveCell.Offset(0, 1).Select End If next end sub
- ベストアンサー
- オフィス系ソフト
- VBAの書き方を教えてください 3
何度も申し訳ございません。 以前にもこちらで質問させて頂いている者です。 Sheet1のrange("A1")をVLOOKUPで検索後の文字を取得し、同じ名前のシートを検索し、さらにrange("A1000")をアクティブにしてここからコードをつなげて処理しています。 range("A1")の処理が終わったら、range("A2")の処理に入り、range("A3") range("A4")を続けて処理を行っているのですが、range("A4")でVLOOKUPの検索が空白の場合、On Error GoTo myErrorで次のrange("A5")の処理に入りますが、On Error Gotoは1回のみの処理しかできないみたいで、range("A５")が空白の場合、実行時エラー9が発生してしまいます。 教えて頂いたコードを解読し、On Error Resume Nextなどを使おうとしているのですが、上手くできません。 １から10まで質問しっぱなしなのですが、どなたかご協力を頂けないでしょうか。 とりあえず自分の必要なコードはある程度省いて、2つ分のみ記載します。 本来この後、10回同じ処理を行います。 よろしくお願い致します。 Private Sub 記帳_Click() On Error GoTo myError1 Dim i As Long Dim myFlg As Boolean For i = 1 To worksheets.Count If worksheets(i).Name = Range("A1").Value Then myFlg = True Exit For End If Next i If myFlg = True Then With worksheets(i) .Activate .Range("A1000").End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveCell = Range("J1") ActiveCell.Offset(0, 1).Select ActiveCell = Range("K1") End With Else MsgBox "該当シートなし" End If myError1: On Error GoTo myError2 For i = 1 To worksheets.Count If worksheets(i).Name = Range("A2").Value Then myFlg = True Exit For End If Next i If myFlg = True Then With worksheets(i) .Activate .Range("A1000").End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveCell = Range("J1") ActiveCell.Offset(0, 1).Select ActiveCell = Range("K1") End With Else MsgBox "該当シートなし" End If End sub
- ベストアンサー
- Excel（エクセル）
- ＶＢＡ超初心者です
皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のｒがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。
- ベストアンサー
- オフィス系ソフト
- VBA Do Until内で値の貼り付けができない
Excel2003を使用しております。 コピー&値のペースト作業をやってくれるマクロを作成しております。 具体的には、名簿に公がついていれば、その３つ左の名前をD27へ値のみコピペし、 D27がすでに値があれば、D28に書くことを、D37までループするようにしております。 しかし困ったことに、Do Untilコードを使用しておりますが、このコードではなぜか値の貼り付けが出来なくなります。 Sub Ns公() Dim work As Range Set work = Selection If Selection.Value = "公" Then ActiveCell.Offset(0, -3).Select Selection.Copy Do Until Range("D37").Select Range("D27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop If Range("D36").Value <> "" Then Do Until Range("I37").Select Range("I27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop work.Select End If work.Select End If work.Select ActiveCell.Offset(1).Select End Sub 原因や対策をご教授いただけるとうれしいです。よろしくお願いします。
- ベストアンサー
- その他（プログラミング・開発）
- VBAで行を挿入する
VBAを始めた初心者です。 Exel2002使用です。 VBAでA列の4行目から10行目に行の挿入をできるようにしようと下記のように書きましたが、Rows("i:i").Selectの部分でデバックがかかってしまいます。間違っている理由がわからないのですがよろしくお願いします。 また、DO While Loopステートメントを使ってA列が空白になるまで（例えばA4セル以下の）行を挿入とする場合の方法も教えていただけましたら幸いです。 Sub 4行目から10行目まで() Dim i As Integer For i = 4 To 10 Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown Next i End Sub Sub 4行目から空白になるまで() Dim i As Integer Range（"A4").serect Do While activecell.value = "" Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown activecell.offset(1,0).select Loop End Sub
- ベストアンサー
- Visual Basic
- Excel2013>VBA>sendkeys動ず
Excel2013のVBAを使って自動更新をしようと思っています。 A B C １ あ AA 0 ２ い AB 1 ３ う AC 0 ４ え AA 1 ５ お AA 0 上記のようにシート内にデータはあります。B列「AA」C列の「ゼロ」を更新してC列の値を「1」にしようとしたときに、ピボットテーブルを使ってみようと思いました。 ピボットテーブルにてB列の「AA」、C列の「ゼロ」を抽出表示しました。 A B C １ あ AA 0 ５ お AA 0 思っていたように1行目と5行目が抽出されました。 後はゼロを別の値（仮に「2」とします）に変更するときに、カーソルの移動がうまくいきませんでした。 Range("C1").End(xlDown).Select Do ActiveCell.Offset(0, 0) = "2" ActiveCell.Offset(-1, 0).Select If Len(ActiveCell.Offset(0, 0)) = 0 Then Exit Do End If Loop しかし、これではカーソルが「C4」に移動してしまいました。 ピボットテーブルでたたんでしまっても、カーソルは見えないセルに移動するようです。 そこで、下記のように変更しました。 Range("C1").End(xlDown).Select Do ActiveCell.Offset(0, 0) = "2" Application.SendKeys "{UP}" If Len(ActiveCell.Offset(0, 0)) = 0 Then Exit Do End If Loop これは、カーソルがまったく動かずに最初の地点にいたままでした。 そこで、次はTABで移動することにしました。 Range("C1").Select Selection.SpecialCells(xlCellTypeVisible).Select Do ActiveCell.Offset(0, 0) = "2" Application.SendKeys "{tab}" If Len(ActiveCell.Offset(0, 0)) = 0 Then Exit Do End If Loop これでもカーソルは動きませんでした。 どうにかしてsendkeysの動かし方、もしくは更新でもっとうまいやり方をご存知の方、是非教えてください。よろしくお願いいたします。
- ベストアンサー
- その他（プログラミング・開発）
- VBA 右端列の削除
このたび初めて質問させていただきます。 周囲にVBAを扱うひとがいないため、初歩的（たぶん？）な質問をさせてください。 以下のようなマクロを記録したのですが、一部を編集したいと考えております。 Columns("F:H").Select Selection.Insert Shift:=xlToRight Columns("A:B").Select Selection.Cut Range("F1").Select ActiveSheet.Paste Columns("J:J").Select→J列固定ではなく右端の列と設定したい。 Selection.Cut Range("H1").Select ActiveSheet.Paste Columns("A:B").Select Selection.Delete Shift:=xlToLeft Columns("J:J").SelectをJ列固定ではなく右端の列を1列設定し切り取りがしたいのです。Range("A2").End(xlToRight).Select ActiveCell.Offset(-1,0).End(xlDown).Select と書き換えてみたのですが、うまく作動しませんでした。 どなたか教えていただけませんでしょうか？
- ベストアンサー
- その他（ビジネス・キャリア）
- マクロでシート２～６のデータをシート１に転記したい
マクロでシート２～６のデータをシート１に転記したいです。 シート２～６のデータを シート１に順番に転記したくてマクロの記録を利用して作成しました。 シート２～６は列は同じですが行数は異なります。 また行数は作業の都度異なります。 同じ記述が繰り返されているので もう少し記述が短くできるのではと思うのですが どうすればいいでしょうか？ Sub データ更新() 'シート１の前回データをクリア Sheets("シート１").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート１").Select Range("A1").Select Sheets("シート２").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート３").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート４").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート５").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート６").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート１").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA
EXCEL VBAで空白行が現れたら「小計」の文字を入力したいと思い以下のように記述しましたが、うまくいきません。どこがおかしいのか教えてください。 宜しくお願いします。 Sub write小計() Dim i As Integer Dim rowcnt As Integer rowcnt = Cells(1, 1).CurrentRegion.Rows.Count Range("B1").Select For i = 1 To rowcnt If Cells(i, 2).Value = "" Then Value = "小 計" ActiveCell.Offset(1).Select Next i End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます