VBA_取消線のある行を検索、その行に操作を加える

質問

取消線のある行を検索して、その行に操作を加えるといったVBAを組みたいです。

①表のB列の最終行を取得する
②B列の13行目から最終行まで④⑤の処理を繰り返す

③取消線のある行を検索する。(行No.を取得？)

④例えば13列目が取消線該当なら　
　その行に入力されている内容をコピー＆枠外にペースト(P)
　B13,C13,G13,I13,J13,K13,L13,M13,N13をコピーする。
　R13にペースト(P)

⑤コピー元のセルを空欄にする_B13,C13,G13,I13,J13,K13,L13,M13,N13

といった流れにしたいのですが、③～が分かりません。
③の"取消線がある行を取得"というよりは、
取消線がなければスルー、取消線があれば④⑤の処理をする流れの方が良いでしょうか。

回答No.4

kkkkkm

> コピー範囲に結合セルがあるようで、それでエラーになっているみたい

上下の結合セルだと思いますが

Cells(i, "B").Resize(1, 13).ClearContents
を
Cells(i, "B").Resize(1, 13).Value = ""
のように

.ClearContents
をやめて
.Value = ""

にしてみたらどうでしょう。上の行と結合している場合そこのデータは消えません。

上の行と結合していても消す場合は
.ClearContentsのところを以下のようにしてみてもいいかもしれません。

For j = Range("B1").Column To Range("N1").Column
Cells(i, j).MergeArea.ClearContents
Next

回答No.3

kkkkkm

D列E列F列とH列はコピーもしなければ削除もしないとかでしたら
取り急ぎですが

Sub Test2()
Dim LastRow As Long, i As Long

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

For i = 13 To LastRow
If Cells(i, "B").Font.Strikethrough = True Then
Range("B" & i & ":C" & i & ",G" & i & ",I" & i & ":N" & i).Copy Cells(i, "R")
Range("B" & i & ":C" & i & ",G" & i & ",I" & i & ":N" & i).ClearContents
Cells(i, "B").Font.Strikethrough = False
End If
Next
End Sub

補足

セルの指定のなかで繰り返し構文が入ったりすると、混乱してしまって、非常に参考になります。
ありがとうございます。

コピー範囲に結合セルがあるようで、それでエラーになっているみたいなので少し粘って考えてみます。

回答No.2

kkkkkm

> B列の13行目から最終行まで

を見逃してました

For i = 1 To LastRow
は
For i = 13 To LastRow

B列からN列までをR列以降にコピペではない場合
どのセルの内容をどこにコピーするのか具体的に説明してください。

補足

ありがとうございます。
B列からN列までをR列以降にコピペでOKです◎

回答No.1

kkkkkm

たとえば
取り消し線が見つかったB列からN列までをR列以降にコピペでB列からN列までのデータを削除でしたら

Sub Test()
Dim LastRow As Long, i As Long

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

For i = 1 To LastRow
If Cells(i, "B").Font.Strikethrough = True Then
Cells(i, "R").Resize(1, 13).Value = Cells(i, "B").Resize(1, 13).Value
Cells(i, "B").Resize(1, 13).ClearContents
Cells(i, "B").Font.Strikethrough = False
End If
Next
End Sub