取消線が使われているかどうかを効率よくチェックしたい

Question

セルにテキストが100文字超埋まっているセルが数百あり
その中で取消線が使われているかどうかをチェックするマクロを使っています。
取消線がどこで使われるかわからないので、
添付のコードのように、1文字ずつ総当たりでチェックしていますので
効率が悪く改善したいと思っています。

For Each なんとか In なんとか
～～
next

と書き、1文字ずつチェックしたら、
僅かながらも効率が改善されるんじゃないかと期待するんですが
そもそも、書けるのか、どのように書けばいいのかがわかりません。
いかがでしょうか？

Sub MyTest()
　Dim rs As Long
　rs = isinStrikethrough(ThisWorkbook.Sheets(1), 3, 4)
　If rs <> 0 Then
　　MsgBox (Format(rs, "0") & "文字目に取消線")
　End If
End Sub

'//----------------------------------------------
'//　取消線が使われているかどうかを判定する関数
'//----------------------------------------------
Function isinStrikethrough(ws As Worksheet, RowNum As Long, ColNum As Long) As Long

　Dim CharCounter As Long
　Dim CharCount As Long
　
　isinStrikethrough = 0
　
　CharCount = Len(ws.Cells(RowNum, ColNum).Value)
　If CharCount <> 0 Then
　　For CharCounter = 1 To CharCount
　　　If ws.Cells(RowNum, ColNum). _
　　　　 Characters(Start:=CharCounter, Length:=1).Font.Strikethrough = True Then
　　　　isinStrikethrough = CharCounter
　　　　Exit Function
　　　End If
　　Next CharCounter
　End If

End Function

Answer 1

1文字ずつ調べずともRange.Font.Strikethroughを見れば存在判定はできると思う

Sub MyTest()
    Dim has As Boolean
    has = HasStrikethrough(ThisWorkbook.Sheets(1), 3, 4)
    If (has) Then
        MsgBox "取り消し線が含まれている"
    End If
    
    Dim rs As Long
    rs = GetStrikethroughCharIndex(ThisWorkbook.Sheets(1), 3, 4)
    If rs >= 0 Then
        MsgBox (Format(rs, "0") & "文字目に取消線")
    End If
End Sub

Function HasStrikethrough(ws As Worksheet, RowNum As Long, ColNum As Long) As Boolean
    Dim rng As Range
    Set rng = ws.Cells(RowNum, ColNum)

    If (rng.Font.Strikethrough = False) Then
        HasStrikethrough = False
    Else
        HasStrikethrough = True
    End If
    
End Function

Function GetStrikethroughCharIndex(ws As Worksheet, RowNum As Long, ColNum As Long) As Long
    Dim rng As Range
    Set rng = ws.Cells(RowNum, ColNum)

    GetStrikethroughCharIndex = -1 '含まれていない
    
    If (rng.Font.Strikethrough = False) Then
        GetStrikethroughCharIndex = -1 '含まれていない
    ElseIf (rng.Font.Strikethrough = True) Then
        GetStrikethroughCharIndex = 1 '含まれている全てにStrikethrough
    Else '部分的に含まれる場合はNothingになっている
        Dim i As Long
        i = 0
        Dim x As Characters
        Set x = rng.Characters(i, 1)
        For i = 0 To rng.Characters.Count
            If (rng.Characters(i, 1).Font.Strikethrough) Then
                GetStrikethroughCharIndex = i - 1
                Exit Function
            End If
        Next
    End If
End Function

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 2

ありがとうございます。

おかげさまで、１０数分の作業が1秒以内に短縮できました。

ここで質問してよかったです。機会があれば、またよろしくお願いいたします。　m(_ _)m