- ベストアンサー
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
- kenkichi55
- お礼率21% (19/87)
- オフィス系ソフト
- 回答数3
- ありがとう数2
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
> どこがまずいのでしょうか? × activeworksheet →ActiveSheet × Range("i:i") 変数を””でくくったらただの文字列です。 Sub sample01() Dim i As Integer With ActiveSheet For i = 1 To 5 .Cells(i, 2) = Mid(.Cells(i, 1), 1, 1) If .Cells(i, 2) = "a" Then .Rows(i).Delete shift:=xlShiftUp End If Next End With End Sub
その他の回答 (2)
- n-jun
- ベストアンサー率33% (959/2873)
ANo.2です。 ちょっとミスりました。スル~して下さい。
- n-jun
- ベストアンサー率33% (959/2873)
For i = 1 To 5 下からの方がいいと言われてますが。 For i = 5 To 1 Step - 1 ActiveSheet.Range("i:i").Delete shift:=xlshiftUp は ActiveSheet.Range( i & ":" & i).Delete shift:=xlshiftUp でしょうか。
お礼
ありがとうございます。 ActiveSheet.Range( i & ":" & i).Delete shift:=xlshiftUp が思いつかなくて苦しんでました。 非常に助かりました。 今後ともよろしくお願いいたします。
関連するQ&A
- VBAの答えを求めています
素人です。誰か教えてください。 下記マクロのend ifより下の部分で時計単位で30分と00分に起動させるように したいのですが起動させるとマクロが常時計算を続けてしまいパンクしてしまします。 sub Macro1() range("E65536").end(xlup).offset(1).resize(1, 4).value = range("A1:D1").value if range("E65536").end(xlup).row > 30 then ’31行に到達してから1行目を削除する range("E1:H1").delete shift:=xlshiftup end if application.ontime application.floor(now, timeserial(0, 30, 0)) + timeserial(0, 30, 0), end sub どうしたら解消できるでしょうか!?
- ベストアンサー
- Excel(エクセル)
- Excel VBAの「FOR~NEXT関数」について
VBAを初めて2ヶ月の超初心者です。 シートが2枚あり、sheet1は仕入金額一覧、sheet2は送付案内書になっています。VBAを利用して「sheet1から1行、sheet2へ転記し印刷後、次の行へ」と言う処理をしています。 Sub 送付案内() Dim 行番号 As Integer For 行番号 = 5 To 298 If Cells(行番号, 15).Value = 1 Then Range(Cells(行番号, 2), Cells(行番号,12).Select Selection.Copy Sheets("送付案内").Select Range(Cells(60, 1), Cells(60, 11)).Select ActiveSheet.Paste Application.CutCopyMode = False Worksheets("送付案内").PrintOut Sheets("作業").Select End If Next End Sub Sub 仕入先名() Dim 行番号 As Integer For 行番号 = 5 To 298 Sheets("作業").Cells(行番号, 2) = WorksheetFunction.VLookup(Cells(行番号, 1), Sheets("仕入先マスタ"). _ Range("$A$3:$B$1135"), 2, False) Next End Sub これでVBAを実行した場合、仕入金額一覧の並び順と微妙(2~3点)に異なる順番で印刷されました。仕入先名や仕入金額に間違いはありませんでした。 同様の経験のある方等、原因がわかる方がいらしたら、教えてください。よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- VBAでの処理分岐方法を教えてほしいです
VBAの分岐処理で悩んでおります。 誰かお助けお願いします。 A列に昇順で番号があります。 1 2 4 4 5 6 9 欠番や重複した数値があります。 やりたいことは欠番箇所に行を挿入し、連番にしたいです。 この例で言うと、3行目に1行を挿入し番号を3と入れる、6行目に2行挿入し7,8と連番にする。 連番になった後に、重複した数値に色を付けます。 以下私が作成したコードです。callで呼び出す予定です。 Sub 欠番判定数式() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Cells(i, 3) = "=if(iserror(if(A" & i & "-A" & i - 1 & ">1,""○"","" "")),"""",if(A" & i & "-A" & i - 1 & ">1,""○"","" ""))" Next End Sub Sub 行挿入() Dim c As Range, Target As Range For Each c In Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row) If c = "○" Then If Target Is Nothing Then ''(1) Set Target = c Else Set Target = Union(Target, c) ''(2) End If End If Next c If Not Target Is Nothing Then Target.Select Selection.EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove End Sub Sub 空白連番入力() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1) = "" Then Cells(i, 1) = (Cells(i, 1).Offset(1, 0).Value) - 1 End If Next End Sub Sub 番号重複確認() Dim i As Integer For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Application.WorksheetFunction.CountIf(Range("$A$2:$A$" & Cells(Rows.Count, 1).End(xlUp).Row), Range("A" & i)) <> 1 Then Cells(i, 1).Interior.ColorIndex = 3 End If Next End Sub このコードを順に全て実行した時、1回目の処理で3行目と5行目に行挿入、そして番号が3と7と入力され連番に色が設定されます。 再度「欠番判定数式」を行い、次は8行目に行挿入し8と連番を入力させ処理を繰り返しさせたいです。 欠番は例として最高2個にしてますが、これから2個以上の可能性もあります。 一度全処理終了後、再度最初の処理(欠番判定数式)に戻り、欠番がある場合は行挿入させという処理を行わせ、欠番がない場合は次の処理に進めるという分岐方法を教えてほしいです。 よろしくお願いいたします
- ベストアンサー
- Visual Basic
- エクセルで型番ごとにワークシートをマクロで作る方法
昨日に質問させて頂いたものですが、下記のマクロを教えて頂いたのですが 新しく生成された型番のワークシートが抜けていたり、最後まで型番が生成されない状態です。 なにか間違っていたら直して頂ける方お願いします。 Sub macro4() Dim h As Range Dim w As Worksheet Dim i As Long, e As Long Application.ScreenUpdating = False Application.CutCopyMode = False ’準備 Set w = ActiveSheet w.Range("4:4").Insert shift:=xlShiftDown e = Range("B65536").End(xlUp).Offset(1).Row Range("B4").Select ’複写 Do ActiveSheet.Copy after:=ActiveSheet Selection.EntireRow.Delete shift:=xlShiftUp Loop Until ActiveCell.Offset(1) = "" ’片付け For i = ActiveSheet.Index To w.Index + 1 Step -1 With Worksheets(i) .Range(.Range("B4").Offset(1), .Cells(e, "B")).EntireRow.Delete shift:=xlShiftUp End With Next i w.Rows(4).Delete Application.ScreenUpdating = True End Sub http://okwave.jp/qa/q7081084.html
- ベストアンサー
- その他MS Office製品
- VBAでの質問
お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.(5,2)がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3) ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub
- ベストアンサー
- Visual Basic
- 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
- インデックスが有効範囲に出ないと出る
下記のようなVBAを書きました。しかしインデックスが有効範囲にないとメッセージがでるのですが、どこがまちがっているでしょうか?? Sub macro1() Dim i As Long Dim r As Long Worksheets("フェアリスト").Select Worksheets("csv").Range("A:C").ClearContents For i = 2 To 50 Step 5 If Worksheets("フェアリスト").Cells(11, i + 1) <> "" Then r = Worksheets("フェアリスト").Cells(65536, i + 1).End(xlUp).Row Worksheets("フェアリスト").Range(Cells(11, i), Cells(r, i + 3)).Copy _ Destination:=Worksheets("csv").Range("B65536").End(xlUp).Offset(1) Worksheets("csv").Range("A65536").End(xlUp).Offset(1).Resize(r - 3, 1).Value = Worksheets("フェアリスト").Cells(8, i).Value End If Next i Worksheets("csv").Range("A1:C1").Delete shift:=xlShiftUp End Sub
- ベストアンサー
- オフィス系ソフト
- Excel2003 VBAで印刷 セル指定
よろしくお願いします。 ボタン5をクリックしてある範囲を印刷したいのですが、私が知っているものはセル指定でActiveSheet.PageSetup.PrintArea = Range("A90:K130") であれが印刷可能なのですが最後の行までにしたいのですがどうしてもうまくいきません。 ActiveSheet.PageSetup.PrintArea = Range(Cells(90, 1), Cells(r, 11)) それと同時に11列全部(文字は小さくてもいいのですが)一枚に印刷したのですが よろしくお願いします。 Private Sub CommandButton5_Click() res = MsgBox("決済記録を印刷します", vbYesNo + vbQuestion) If res = vbYes Then r = Range("A65536").End(xlUp).Row + 1 'Range(Cells(90,1),Cells(r,11)) '印刷したい範囲 ActiveSheet.PageSetup.PrintArea = Range("A90:K130") ActiveSheet.PrintOut preview:=True End If End Sub
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。
- ベストアンサー
- オフィス系ソフト
- VBAで教えてください。
以前ここで教えていただいたVBAで http://jisaku.155cm.com/src/1371930716_9b9006528605642980beed48a8998013b0731e4b.jpg のようにA列のテスト4をクリックしたときにC列のテスト4が一発で解るようにしたいです。 もちろん、テスト11をクリックしたときは、テスト4塗りつぶしは解除され、 テスト11が塗りつぶされるようにしたいです。 写真は塗りつぶししていますが、解るようにしたいだけなので、塗りつぶしにはこだわっていません。 あと、E、F、G列は解りやすく並べているだけで、実際はA、B、C列だけです。 それと、C列は関数を使って表示してあります。 という質問で Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("C:C").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "C") = Target Then Cells(i, "C").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで をシートのコードに張り付ければいいですよ。と教えてくれたものがあるのですが、 A列でクリックした文字をC列からすべて見つけて反転してくれないようです。何個か反転してくれない ものが出てきてしまいました。 C列が何百行とかなってしまうと、すべての同じ文字を検索してくれないのでしょうか? ちなみに列がここに掲載しているものと違うので Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("R:R").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "R") = Target Then Cells(i, "R").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで のCをRにAをBに変更して使ってます。 これがいけないのかな? よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます。 .Rows(i) というのが勉強になりました。 また質問させていただくこともございますが、 その節はよろしくお願いいたします。