エクセルマクロで行挿入

質問

エクセルマクロで行挿入

マクロ初心者です。
仕事で、受注した内容をエクセルで管理しているのですが、頻繁にキャンセルや日程変更があり、１日単位でデータを管理しているものですから、かなりデータ入力に労力が取られている状況です。
キャンセルや日程変更になったデータに関しては、行ごと削除するのではなく、行単位で取り消し線と文字を赤にして、見た目で無くなったということがわかるようにしています。
また、受注したら行を挿入して新しいデータを入力しています。

そこで、赤字で取り消し線にて入力されている行の一つ上の行に挿入、ということをマクロでできないかと思っています。
赤字に取り消し線の行に関しては、何行目になっているかはその日によって違うので、その指定と、書式を指定する方法がわからない状況です。

マクロで上記のことができるのであれば、ご教授いただけると助かります。
宜しく御願いいたします。

回答No.2

imogasi · ベストアンサー

VBAで出来る。
しかし質問者には難しいと思う。
全セルを舐めて聞くなら難しくは無いが、これはスマートでないと言う思いがあるので、Findを使ってみた。
しかし私も苦労した。値の検索と違って、WEBにも、書式の検索の例は探すのが難しいのと、Findそのものの使い方の難しさがある。
また行挿入は以下行の位置をヅラすので、扱いが難しい。それで最下行から上に向かって処理をやったりする。
（１）　フォント色が赤で、かつ
（２）　取り消し線が引いてある
（３）　（１）（２）のセルは同一行には２つない（これをはずすと、ロジックが少し複雑になる）
の３条件であること。
シートでの存在するセルの位置は問わない。
ーーー
Sub test01()
Range("b1").Activate
fst = "y"
Application.FindFormat.Font.Color = vbRed
Application.FindFormat.Font.Strikethrough = True
Do
Set r = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=True)
MsgBox r.Row & "=" & mae
If r.Row = mae Then Exit Do
r.EntireRow.Insert
r.Offset(2, 0).Activate
If fst = "y" Then mae = r.Row
fst = "n"
Loop Until r Is Nothing

End Sub
一応テストしてますが、さらに充実したテストが必要。

補足

ご解答ありがとうございます。
さっそくＶＢＡでやってみたらできました。
理想的です。ありがとうございます。

ｍｓｇｂｏｘが出てくるのですが、これが出なくなる方法はあるのでしょうか？

回答No.1

tom04

こんにちは！
希望通りでなかったらごめんなさい。

A列から赤の取り消し線が入っているとします。
複数行ある場合はすべての取り消し線が入っている1行上に行が挿入されてしまいますが・・・
一例です。

操作したいSheet見出し上で右クリック　→　コードの表示　を選択し↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub test1()
Dim i As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1).Font.ColorIndex = 3 And _
Cells(i, 1).Font.Strikethrough = True Then
Rows(i).Insert
End If
Next i
End Sub

最初に書いたように複数行ある場合は取り消し線が入っている行すべてに適用されてしまいますので、
データを入力後、空白行を削除するコードも載せておきます。

Sub test2()
Dim i As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) = "" Then
Rows(i).Delete (xlUp)
End If
Next i
End Sub

この「test2」を実行すれば、余分な空白行は削除されると思います。

以上、参考になれば良いのですが、
的外れならごめんなさいね。m(__)m