プロが教える店舗&オフィスのセキュリティ対策術

マクロ初心者です。

「K列の数字の変化ごとに行を一行挿入する」
マクロを作成致しました。

Sub 挿入()
Const NowCol = 11 'K列
Const InsRows = 1 '1行挿入
Dim NowRow
Dim NowVal, PreVal
PreVal = Range("K1")
NowRow = 1
Do
NowRow = NowRow + 1
NowVal = Cells(NowRow, NowCol).Value
If NowVal = 0 Then Exit Do
If PreVal <> NowVal Then
Rows(NowRow & ":" & NowRow + InsRows - 1).Select
Selection.Insert xlDown
PreVal = NowVal
NowRow = NowRow + InsRows - 1
End If
Loop
End Sub

(正しいか不安です。間違っていれば指摘下さい)
ただ、これではシート全体に適応してしまいます。
範囲指定した複数の行のみ(範囲は毎回変わります)
にだけマクロを実行したいのです。

例えば、データが1~100列まで入ってるとして、
その中の5~30列だけ指定しK列の数字の変化ごとに、
一行挿入をさせる。(指定列は毎回変わります)

まったくの初心者で上記のマクロを皆様を参考に、
やっと動くように出来た程度です。
どうかご教授お願いします。宜しくお願いします。

A 回答 (4件)

同じことを私なりにやって見ました。

少数例ではOKのようです。K-->A列に直しています。
Sub test01()
i = 2
m = Cells(1, "A")
Do
If Cells(i, "A") = "" Then Exit Do
 If m <> Cells(i, "A") Then
  m = Cells(i, "A")
  Cells(i, "A").EntireRow.Insert
  i = i + 2
 Else
  i = i + 1
 End If
Loop
End Sub
朝で質問の答えを考える時間が無くてここまでにします。
    • good
    • 0

#2です。


>要警戒とはどう意味なのでしょうか。
十分プログラムロジックを考えぬくことをお勧めしますと言うことで、正しく動けば、その後も心配せよと言うことではありません。私が苦労したと言うぐらいに受け取ってください。#3の方の工夫やご苦心の理由もそれを裏付けるものです。
>私の要求してる事はかなり無理があるのでしょうか
それは無いでしょう。ただ「初心者」(ご自分でおっしゃっているので。失礼。)のかたが、思いつく常識的な、「やりたいこと」がプログラムではAPIなどを使わないと実現できないことは、多々あるようです。
>別シートに出すとゆうのは・
Sheet1のA列の前行と当行を比較して、変らなければ、Sheet1のA列当行と同じものを,Sheet2
のA列の指定行に書く。変ったらSheet2の行を1行進める(従って空白行が出来る)と言うものです。Sheet2のデータをセットすべきポインタ的整数を持って指定行を管理する必要があります。
#3のtaisuke555さんへ
If (TypeName(Selection) = "Range") Then
など経験不足で、考慮できていません。ご教示ありがとうございました。プログラムは標準的なケースでは上手く行っても、色んなケースでは、油断ならない1例ですね。
    • good
    • 0

私は、行の挿入や削除をする場合、下の行から処理していきます。


(imogasiさんの終了行が動くプログラムは要警戒と同じ理由だと思いますが)

上記プログラムなら以下の様に作ります。(私なら)
テストでは問題なかったですがバグがあったらすみません。
このプログラムの
  For i = Range("K65536").End(xlUp).Row To 2 Step -1
  の部分を
  For i = 2 To Range("K65536").End(xlUp).Row
  にして実行すると下の行から処理している理由が分かるかも。
  (#2のプログラムの
   i = i + 1 + 1 '1行ずれて、その次ぎの行を対象にする
   l = l + 1 '最終行が下へ1行ずれる
   のあたりも参考に)

Sub test()
  Dim i As Long
  'K列の入力されている最後の行から2行目まで(シートの最後の行からではない)
  For i = Range("K65536").End(xlUp).Row To 2 Step -1
    '入力されている行のみ処理
    If (Cells(i, "K") <> "") Then
      '1行上の値と違っていて1行上に入力がある場合
      If (Cells(i, "K") <> Cells(i - 1, "K") And Cells(i - 1, "K") <> "") Then
        '1行挿入
        Range(i & ":" & i).Insert xlUp
        'Cells(i, "K").EntireRow.Insert xlUp 'こちらでも可
      End If
    End If
  Next i
End Sub

範囲指定するのは、imogasiさんも書かれているように
Selectionを使用しますが、
Selectionは結構広範囲の使用が可能ですので、いくつか注意しなければいけないと思います。

(1)選択されているものがSelectionに入ってくるので、
   例えば図を選択して実行すると、エラーになってしまいます。
   If (TypeName(Selection) = "Range") Then
   で、セルが選択されているか確認
(2)例えば、10~13行、15~20行(Ctrlを押して選択)した場合、
   Selection.Areas.Count = 2
   Selection.Areas(1).Row = 10
   Selection.Areas(1).Rows.Count = 4
   Selection.Areas(2).Row = 15
   Selection.Areas(2).Rows.Count = 6
   になります。
   15~20行、10~13行の順に選択すれば、
   Areas(1)とAreas(2)が入れ替わります。

私がSelectionを使ってみて気になる所なので、他にもあるかもしれません。

サンプル作ったのですが、今1つ納得いく作りにならなかったので、記載するのはあきらめました。

何故、範囲指定したいのかわかりませんが、
私の記述したプログラムは、シート全体に適応していますが、数字が変わった時に、
行を挿入していない所だけ、行を挿入するようにしてありますので参考になればと思います。
    • good
    • 1
この回答へのお礼

お礼が大変遅くなり申し訳ございません。
大変参考になりました。
ありがとうございました。

お礼日時:2004/05/05 14:21

#1です。

ご質問の内容はこうだろうと推測して、下記を作りました。(<-範囲指定した複数の行のみ(範囲は毎回変わります) にだけマクロを実行したいのです)
A列に,同じ文字列が連続したり、単独だったりと並んでいるとします。
例えばA9:A15に
g
g
h
h
k
f
k
とします。
このA9:A15を範囲指定(任意指定の1つの例)して、下記を実行すると
g
g

h
h

k

f

k
となります。
Sub test01()
i = Selection.Row '選択範囲の最上行
l = i + Selection.Rows.Count '選択範囲の最下行+1
' MsgBox i & "," & l
m = Cells(i, "A") '第1行目を前行とする
i = i + 1 '次行に注目を進める
Do
If i = l Then Exit Do
If m <> Cells(i, "A") Then '前の行と比較して変わったか
'変ったとき
m = Cells(i, "A")
Cells(i, "A").EntireRow.Insert
i = i + 1 + 1 '1行ずれて、その次ぎの行を対象にする
l = l + 1 '最終行が下へ1行ずれる
Else
'---変らないとき->何もしない
i = i + 1 '次ぎの行を対象にする。
End If
Loop
' MsgBox l
End Sub
Selection.Rowは500ページの解説本にさえも載ってないかも。初等的ではないと思う。また終了行が動くプログラムは要警戒で私は好きでない。私は別シートに出します。その方がロジック的に安定していると思う。
    • good
    • 0
この回答へのお礼

ありがとうございます。

>また終了行が動くプログラムは要警戒で私は好きでない。私は別シートに出します。その方がロジック的に安定していると思う。

すいません。内容がよく分かりません。
要警戒とはどう意味なのでしょうか?
私の要求してる事はかなり無理があるのでしょうか?
別シートに出すとゆうのは・・・?
詳しく教えていただけますでしょうか?
初心者な上、勉強不足ですいません。

お礼日時:2003/08/20 00:29

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A