• 締切済み

エクセル VBAについて

はじめて質問するのですが(閲覧もほとんどしていませんでした)、 ネチケット違反等がありましたら申し訳ありません。 エクセルVBAで下記のようなことをしたいのですが、 できずに困っています。 A列で文字が入っているセルを、上から下まで確認し、 『在庫』という文字が入ってるセルの下2行に空白行を入れたく 思っています。 とりあえず自分で作ってみたのは、 ******************** Sub 行挿入() Dim i As Integer Dim a As String For i = 1 To 1000 Cells(1, i).Value = a If a = "在庫" Then Rows(i + 1).Insert Rows(i + 2).Insert Else End If Next i End Sub ************************************ 初心者で申し訳ないのですが、上記を実行すると、 アプリケーション定義&オブジェクト定義というエラーが出ます。 何がいけないのでしょうか? 恐れ入りますが、教えてください。 よろしくお願い致します。

みんなの回答

noname#91724
noname#91724
回答No.7

#2でございます。 #4様回答のコードで動きますがねえ・・。 必ず文字が「在庫」である必要があり、「在庫 」とかだと動きませんが、 そこらへんはどうでしょうか。 若干の追加で、条件が真の時は、i =i + 2 としておくと、挿入した行をカウントしないので若干早くなります。 あとFORが1から1000になっているのは余裕を持ってのことだと思いますが、 実際に1000行あるとしたら、最後のほうは「在庫」があった場合でも、 機能しなくなるのでご注意。 (仮に全部の行に「在庫」があった場合、333行あたりで検索は終わる)

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.6

#04です >何も動きがありませんでした。 とのことですが、マクロを実行する際のアクティブシートは「在庫」が入力されたシートになっていますか? またセキュリティレベルが「高」になっていてマクロが実行できない状態になっているようなことはありませんか? (レベルは「中」にします) もしその点は正しいのなら、ステップ実行して確認されたらいかがでしょうか。VBE画面でコードの行のバーをクリックしてブレークポイントを設定すればマクロ実行がその行で止まりますから、F8で1行ずつ動作を確認できます。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.5

今までの回答に出てないが(既回答はうまく動くか良くチェックしてください) ーー 行削除 行挿入 は下の行からやっていくのが定石と思う。 For i = 1000 To 1 Step -1 上からやったら、挿入した行で全体行数が膨れ上がって、最初の終値1000行目は、上からいくらの番号の行になっているんだったケ?と混乱します。終値1000を増やしていくのもややこしいし。

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.4

Cells(1,i)と書いたら動きません。行、列を間違えていますよ。 Cells(1, i).Value = a も代入の方向が反対です Excelでは列は256までしかないのでエラーになるはずです。(でも違うメッセージになるはずだけど…) Sub 行挿入() Dim i As Integer  For i = 1 To 1000   If Cells(i, 1).Value = "在庫" Then    Rows(i + 1).Insert    Rows(i + 2).Insert   End If  Next i End Sub なら動くと思います。  Cells(i + 1, 1).Resize(2, 1).EntireRow.Insert や  Rows(i + 1 & ":" & i + 2).Insert なら2行いっぺんに挿入できます。 ただしRowsやCellsなどのレンジオブジェクトは  Activesheet.rows(i) のようにシートを明示する方がよいですよ

daue58
質問者

お礼

ご回答ありがとございました。 すぐ回答頂いたにも関わらず、お礼が遅くなり申し訳ありませんでした。 ところで Sub 行挿入() Dim i As Integer  For i = 1 To 1000   If Cells(i, 1).Value = "在庫" Then    Rows(i + 1).Insert    Rows(i + 2).Insert   End If  Next i End Sub これでマクロ実行してみたのですが、何も動きがありませんでした。 A列のセルには「在庫」の文字が入っているのですが・・。 なぜだろう?と再度考えている所です。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんばんは。 >アプリケーション定義&オブジェクト定義というエラーが出ます。 それは、Cells(1, i).Value = a  で、列が、1000までないからです。 たぶん、Rows(i + 1).Insert なら、下に行くはずですから、 Cells(i, 1).Value ではないでしょうか? Rows(i + 1).Insert Rows(i + 2).Insert     ↓ Rows(i + 1 & ":" & i + 2).Insert  '一緒にしてよいと思います。

daue58
質問者

お礼

ご回答ありがとうございました。 Cells(1,i)ではなく、Cells(1,i)でした。 こんな基本的なことを間違えるとは・・。

noname#91724
noname#91724
回答No.2

とりあえず、 Cells(1, i)は Cells(i, 1)のような気がする。

daue58
質問者

お礼

ご回答ありがとうございました。 Cells(i,1)でした。 これは修正したのですが、まだ実行できずにいます・・。

  • nakax
  • ベストアンサー率13% (15/114)
回答No.1

If a = "在庫" Then  Cells(1, i).Value =Rows(i + 1).Insert  Cells(1, i).Value =Rows(i + 2).Insert  Else End If こんな感じで、どこにRowsを入れないか、 指定しないと駄目なんじゃないですか?

関連するQ&A

  • 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

  • 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

  • エクセルVBAコピーしたセルを順番に張り付ける方法

    おはようございます。 for文の処理方法がわからないので質問します。 やりたいこと 例・sheet2・sheet2・sheet4・・・と A~B列のセルに文字が有る場合 B列のセルに文字が有れば その行全体をコピーして 【貼り付け】シートに張り付けたいのですが 私の考えたコードだと コピーまではうまくできるのですが 【貼り付け】シートに行全体を張り付ける際 行を上書きされてしまいます。 (sheet2の行を張り付けたら 次にsheet3の行を貼り付けシートに上書きしてしまう) このような上書きをされずに すでに【貼り付け】シートにコピーされたものが有る場合 一つ下の行に貼り付けって出来ないでしょうか? コードを下記に記載します。 すいませんがコードを書いて頂けると助かります。 宜しくお願い致します。 追記:【貼り付け】シートは一番左端にあります。 Sub test() Dim b As Variant Dim i As Long Dim io As Integer Const  AAA  As String = "" Set b = Worksheets("貼り付け") For i = 1 To 100 For io = 2 To ThisWorkbook.Worksheets.Count If WorksheetFunction.CountIf(Worksheets(io).Rows(i), "") > 0 Then  Worksheets(io).Rows(i).Copy   b.Rows(i).Offset(1, 0).PasteSpecial (xlPasteAll)’ここの貼り付け方が間違ってますよね・・・ End If Next Next End Sub

  • Excelセル範囲内の値のみ1行空欄にする

    下記コードでは1行づつ挿入により下段までずれてしまいます。 Excelセル範囲内の値のみ1行づつ開けるにはどのようにすれば良いでしょうか。 どなたか解る方よろしくお願いします。 Sub 空欄1行() Dim i As Long If TypeName(Selection) <> "Range" Then Exit Sub With Selection For i = .Rows.Count To 2 Step -1 Intersect(.Cells(i, 1).EntireRow, .Columns).Insert xlDown Next End With End Sub

  • 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個以上の可能性もあります。 一度全処理終了後、再度最初の処理(欠番判定数式)に戻り、欠番がある場合は行挿入させという処理を行わせ、欠番がない場合は次の処理に進めるという分岐方法を教えてほしいです。 よろしくお願いいたします

  • エクセルのマクロについて

    下記は、A列3行の7文字目~10文字と B列5行~文字のある最後の行までの範囲の左から1文字目~4文字 に相違がある場合 MsgBox i & “行目” を出す。 というマクロなのですが、『B列5行~文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub

  • VBAプロシージャの間違いを添削願います

    A列からD列にかけてデータが入力されます。B列には4桁の数値が入力されており、 この4桁の数値を利用して、次のようにデータを管理したいと思います。 1.4桁の数値が同じものを抽出する。 2.抽出された数値は、最初に出現している数値の下の行に挿入する。 3.最初に出現している数値以外は削除する。 4.各行は空行が無い状態とする。 これをプロシージャにしたものが下記です。 Sub 重複行削除() Dim lastgyou As Integer Dim i As Integer Dim j As Integer Dim atai As Integer lastgyou = Range("B1").End(xlDown).Row For i = 1 To lastgyou - 1 atai = Cells(i, 2).Value For j = i + 1 To lastgyou If atai = Cells(j, 2).Value Then If j <> i + 1 Then Rows(j).Cut Rows(i + 1).Insert Shift:=xlDown End If i = i + 1 End If Next j Next i End Sub としましたが、重複行が削除されません。 ご教授をお願いいたします。

  • VBA教えて下さい

    for nextの使い方がわかりません 変数を使用し条件に当てはまる数値だけ 処理するといった内容です 考えたコード sub test() dim a as variant dim b as variant dim i as variant with workbooks("book1").activesheet set a =.range("A5") set b =.range("B5") end with with workbooks("book2").activesheet for i = 80 to 110 if a = cells(i,1) then b.value = cells(i,2) end if next i end sub このコードにてやりたい事は まず、book1の今開いてるシートを参照し A5セル、B5セルをセットし (例えばA5は2と入力している B5セルは10000と入力している) 次に、book2の今開いてるシートを参照し もし、1行目の80~110どれかのセルの数字が 変数aと同じ値ならば (A行80~110行のセルの数字2があれば 例えば85列) 変数bの数字を2行目の80~110に条件に当てはまるセルに移す (B行85列にB5セルの値10000を移す) ()の部分は例えで書いてます 読みにくかったら無視でお願いしますm(__)m 指定の仕方など間違ってると思うので コードを書いてくれると助かります 回答お願いしますm(__)m

  • EXCEL(VBA)で1行おきに行を選択する方法

    こんにちは。VBAは苦手なので教えてください。 EXCELのsheet1にあるリストに、下記マクロで1行おきに 空白行を挿入しました。 Sub test1() '隔行で空白行を挿入 Dim rw As Long 'セル For rw = Range("A1").End(xlDown).Row To 2 Step -1 Rows(rw).Insert Next End Sub 同じファイルのSheet2の1行目<Rows("1:1")>に、計算式が入力されています。 マクロで挿入した空白行全てを選択し、そこへSheet2の1行目のコピーを 貼り付けたいです。 ぜひ、良い方法を教えてください。

  • excel vba

    VBAに不慣れなので教えてください。 今下記のプログラム(A1セルで青色以外の文字を消去する)はA1セルのみを対象にしているのですが、 (1)セルをA1からA3までにする。 (2)処理対象をA1のある列を対象とするようにしたい。 各々どう手直しすればいいか。 プログラムtest Public Sub test() Dim r As Range Dim i, wk As String Set r = Range("A1") wk = "" For i = 1 To Len(r.Value) Debug.Print r.Characters(i, 1).Font.ColorIndex If r.Characters(i, 1).Font.Color = vbBlue Then wk = wk + r.Characters(i, 1).Text End If Next r.Value = wk r.Characters.Font.Color = vbBlue End Sub

専門家に質問してみよう