kurukuru-papaのブログ

主に、ソフトウェア開発に関連したメモを書き溜めたいと思います。

取消線属性の付いた文字列を除去する関数

Excelでは、1つのセルに含まれるテキストに対して、部分的に取消線を引いたり、色を付けることが可能です。

この機能を利用して、テキスト内容の変更を履歴管理することがあります。
変更前の文字列に取消線を引き、変更後の文字列を通常文字や赤文字で記述することがあります。

こんなとき、変更後の内容だけを取り出したいことがあります。
そのための関数を用意しました。

Function 取り消し文字除去(cell As Range)
    Dim count As Integer
    Dim i As Integer
    Dim char As Characters
    Dim result As String
    
    count = Len(cell.Text)
    For i = 1 To count
        Set char = cell.Characters(i, 1)
        If Not char.Font.Strikethrough Then
            result = result + char.Text
        End If
    Next
    
    取り消し文字除去 = result
End Function

二分木の要領でスピードアップしてみました。

Function 取消文字除去(cell As Range, Optional start As Integer = 1, Optional length As Integer = 0)
    Dim char As Characters
    Dim half As Integer
    Dim result As String
    
    ' 開始位置引数が無効の場合、1とする。
    If start <= 0 Then
        start = 1
    End If
    
    ' 長さ引数が無効の場合、開始位置以降すべてとする。
    If length <= 0 Then
        length = Len(cell.Text) - start + 1
    End If
    
    ' 二分木の要領で処理
    Set char = cell.Characters(start, length)
    Select Case char.Font.Strikethrough
    Case False
        ' すべての文字が通常文字
        result = char.Text
    Case True
        ' すべての文字が取消文字
        result = ""
    Case Else
        ' 取消文字、通常文字の混在
        half = length / 2
        result = 取り消し文字除去(cell, start, half)
        result = result + 取り消し文字除去(cell, start + half, length - half)
    End Select
    
    取消文字除去 = result
End Function