取り消し線が入った文字を削除する処理を速くしたい（VBA）

Question

取り消し線の入った文字を一気に削除したいと思い、VBAで下記を実行しようとしましたが、
選択範囲が多いため非常に時間がかかっております。
（ネットで見つけた構文に少し手を加えています。）
速くする方法あれば構文をご教授お願いいたします。

　　Dim lastRow As Long
       Application.ScreenUpdating = False
        lastRow = Cells(Rows.Count, "K").End(xlUp).Row
        Range("K7", Cells(lastRow, "S")).Select
        For Each myCell In Selection
            textBefore = myCell.Value
            textAfter = ""
            For i = 1 To Len(textBefore)
                If myCell.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                    textAfter = textAfter & Mid(textBefore, i, 1)
                End If
            Next i
            myCell.Value = textAfter
        Next myCell
       Application.ScreenUpdating = True

enunokokoro · Accepted Answer

No.1のお礼にあるmyCell.Font.Strikethrough = Trueだと、削除
されるように書かれていますね。
Next i
myCell.Value = textAfter
この順番が逆にならないと削除されます。

セル内の一部に取り消し線がある文字列のみを対象にする場合は、
上記でのTrueでは判定できないと思います。
 If (IsNull(n) = True) Then
このような判定でないと、処理がされません。

処理の速さは別にして、判定処理するものをお礼のマクロに追加を
してみました。

Sub StrikethroughDelete()
Dim lastRow As Long
Dim textBefore As String
Dim textAfter As String
Dim myCell As Range
Dim i As Long
Dim n As Variant
n = Null

Application.ScreenUpdating = False
 
　lastRow = Cells(Rows.Count, "K").End(xlUp).Row
　Range("K7", Cells(lastRow, "S")).Select

For Each myCell In Selection
　　textBefore = myCell.Value
　　textAfter = ""
　　n = myCell.Font.Strikethrough

If (IsNull(n) = True) Then
　　　　For i = 1 To Len(textBefore)
　　　　　If myCell.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
　　　　　　textAfter = textAfter & Mid(textBefore, i, 1)
　　　　　End If
　　　　Next i
　　　　　myCell.Value = textAfter
　　　　Else
　　　　　If myCell.Font.Strikethrough = True Then
　　　　　　myCell.ClearContents
　　　　End If
　　　End If

Next myCell

Application.ScreenUpdating = True
End Sub

googoo900 · Answer

コードの最初に以下を追加する。
すべての変数の型宣言を追加することで、若干速くできるはずです。効果は未検証ですがそんなに大きくはないです。
Dim textBefore as String
Dim textAfter as String
Dim myCell as Range
Dim i As Long

taku-9023.ham · Answer

＞For i = 1 To Len(textBefore)
＞If myCell.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
＞textAfter = textAfter & Mid(textBefore, i, 1)
＞End If
＞Next i

その前に条件分岐するようにしてみては？
もし、その文字全体のFont.StrikethroughがFalseだったら何もしない。
その他はそのままのように。

もし、取り消し線が入っているセルの方が多かったら逆でやったらいいと思います。
それ以上の短縮はちょっと思いつきません。
お力になれれば幸いです。

取り消し線が入った文字を削除する処理を速くしたい（VBA）

No.1のお礼にあるmyCell.Font.Strikethrough = Trueだと、削除

コードの最初に以下を追加する。

＞For i = 1 To Len(textBefore)

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

関連するカテゴリからQ&Aを探す

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

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング