VBAで対象セルが空白の間動作を繰り返す方法は？
- 対象セル範囲が空白になった時点で動作を止める方法を教えてください。
- VBAを使用してセルが右端まで移動し、対象セルが空白になったときに動作を停止したいです。
- VBAで空白の間動作を繰り返す際に、対象セル範囲が空白になったときに停止する方法を知りたいです。
- ベストアンサー
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
- yasushi0715
- お礼率60% (3/5)
- Visual Basic
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
あ、しまった。 frag初期化するの忘れてました。 ■修正版 ------- Sub sample() Dim u As Integer, o As Integer, c As Range, frag As Boolean Application.Calculate For u = 2 To 3 For o = 7 To 2000 frag = False If Cells(u, o) = "" Then Range("G2").Select Range("G2").End(xlToRight).Select If Selection.Value <> "" Then ActiveCell.Resize(6, 5).Select For Each c In Selection If c.Value <> "" Then frag = True Exit For End If Next If Not frag Then Exit Sub End If Else Exit Sub End If Selection.Cut Range("B2").Select Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste End If Next o Next u End Sub
その他の回答 (1)
- shirokuma2014
- ベストアンサー率25% (41/162)
こんにちは！ G2を基準にして右End移動し、指定した範囲をコピーして、B2を基準にして下End移動した一番したのセルにペーストするのですか？？ なぜこういう業務が必要なのかよく分かりませんが、 エクセルの基本機能である「コピー」→「行列入れ替えて貼り付ける」で実現可能な気も…。 表がどういう構造をしているのかよく分からないのですけど、今のまま実行すると ActiveCell.Resize(6, 5).Select の行で再右端に行ってエラーになりませんか？ 公開されているコードに付加する形でコードを書きました。 (されたいことをほとんど推測で書いてますので、意図した通りに動かないかも) ForNextとCellsを習得されているのなら、次は Cells(u,o).value = Cells(o,u+1).value のような書き方を覚えられるのをオススメします。 おそらく2,3行になります。 ----- Sub sample() Dim u As Integer, o As Integer, c As Range, frag As Boolean 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 If Selection.Value <> "" Then ActiveCell.Resize(6, 5).Select For Each c In Selection If c.Value <> "" Then frag = True Exit For End If Next If Not frag Then Exit Sub End If Else Exit Sub End If Selection.Cut Range("B2").Select Range("B2").End(xlDown).Select ActiveCell.Offset(1).Select ActiveSheet.Paste End If Next o Next u End Sub
関連するQ&A
- 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 よろしくお願いします。
- 締切済み
- Visual Basic
- ＶＢＡ超初心者です
皆さんのお知恵を拝借させてください。 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になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。
- ベストアンサー
- オフィス系ソフト
- 行方向の同じ値のセルを結合するマクロ
ネットで色々調べながら、A列方向の同じ値のセルを結合させるマクロ を作ってみたのですが、もっと簡単にできるようでしたら教えていただきたいです。 どうぞよろしくお願いいたします。 Sub セル結合() Dim r As Integer '行数 Dim i As Integer 'カウンタ r = Sheets(1).Range("a1").CurrentRegion.Rows.Count - 1 Application.DisplayAlerts = False For i = 1 To r Cells(i, 1).Activate '項目の一つ下のセルをアクティブに If ActiveCell.Value = ActiveCell.Offset(1).Value Then Range(ActiveCell, ActiveCell.Offset(1)).Merge End If Next Application.DisplayAlerts = True End Sub
- ベストアンサー
- その他MS Office製品
- 空白セルと０値を識別させたい。（VBA）
すみません、誰か教えていただけますか。 シートの53、54、55行目にそれぞれ値入っています。 それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が 続く部分の合計を出しています。 しかし、下記の記述ですと数値が0（変数D=0）の時に うまくいきません。空白セルと認識されてしまうと思います。 何か、良い方法があれば教えて頂けませんでしょうか。 宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル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
- ベストアンサー
- オフィス系ソフト
- 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
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA FREQUENCY関数での設定について
我流でVBAを勉強し、マクロを作っている者です あるデータの度数分布を調べるマクロをつろうとしていますが、うまくいきません。 FREQUENCY関数のデータ範囲の指定で変数を使いたい（元のデータが日を追う毎に増えていくので・・・）のですが、エラーになります。どこが変でしょうか？ よろしくお願いします。 Sub データ最終行を調べる() Dim 総件数 As Long Dim 値 As Integer 総件数 = 100000 Sheets("データシート").Select Range("d2").Select For G = 1 To 総件数 値 = ActiveCell.Value If 値 = 0 Then Exit For Else ActiveCell.Offset(1, 0).Activate End If Next G gyou = ActiveCell.Row dataHANI = Range("d2:d" & gyou) End Sub Sub 度数分布を調べる() データ最終行を調べる Sheets("度数分布").Select Range("B2:B21").Select Selection.FormulaArray = "=FREQUENCY(dataHANI,a2:a21)" 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（エクセル）
- VBA Copy/Paste メソッド
エクセル２００２使用です。 sheet１のA7からD19セルの値を sheet２のB列の一列に転記をしたいのですが、 コピーが上手くできません。 Copy、Pasteメソッドを使用するときの セルの選択が良くわからないのですが、 よろしくお願いします。 Sub tenki() Dim i As Integer Dim j As Integer For i = 7 To 19 For j = 1 To 4 Cells(i, j).Copy Worksheets("sheet2").Activate Range("B65536").End(xlUp).Select ActiveCell.past ←ここでエラー（注） Next j Next i End Sub （注） エラー オブジェクトは、このプロパティーまたはメソッドをサポートしていません。
- ベストアンサー
- オフィス系ソフト
- VBAで関数式の値をセルに入力できるようにしたい。
こんなマクロをマクロの記録で作ったのですが SUMIF関数の数式をセルに入力するのでなく 値だけを入力するしたいのですがどのように すればいいでしょうか? Sub Macro4() Columns("O:O").Select Selection.Insert Shift:=xlToRight Range("N3").Select Selection.AutoFill Destination:=Range("N3:O3"), Type:=xlFillDefault Range("N3:O3").Select Range("O5").Select ActiveCell.FormulaR1C1 = "=SUMIF(出荷貼付け!C1,RC1,出荷貼付け!C5)" ←ここのところを値だけをセルに入力したい。 Selection.AutoFill Destination:=Range("O5:O978") Range("O5:O978").Select Range("O4").Select End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます！ 私がVBA勉強し始めたばかりで、かなり変な形になってると思います。 先に進めました。