[Excel VBA] 選択範囲のセルの取り消し線がついた文字を削除する

ai
おはようございます。
「ai」です。

実行すると選択した範囲内で取り消し線がついた文字を削除します。

セル内に取り消し線がついていない文字とついた文字が混在していた場合は、取り消し線の文字のみ削除されます。

書式はなるべく維持するようにしていますが、文字列の一部のみ色や書体を変更している場合などは維持できません。

また、文字列を削除したセルの背景色を変更する処理が入っていますが、必要なければ削除しても構いません。

取り消し線がついた文字を削除

Public Sub Delete_Strikethrough()

    Dim Target_Sheet As Worksheet
    Dim Select_Cell As Range
    Dim Target As Range

    '背景色変更フラグを初期化
    '※取り消し線がついた文字を削除したセルの背景色を変えるならTrue、変えないならFalse
    Color_Flag = False

    '背景色を変更する際の色 ※RGB値で指定
    Color_R = 255
    Color_G = 180
    Color_B = 40

    '描画などを無効化
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    '処理対象のシートを記憶する
    Set Target_Sheet = ActiveWorkbook.ActiveSheet

    '処理対象のシートをアクティブにする
    Target_Sheet.Activate

    '選択した範囲のセルを一つ一つループする
    For Each Select_Cell In Selection

        '対象シートをアクティブにする
        Target_Sheet.Activate
        
        '修正用変数を初期化
        After_Text = ""

        'セルの文字列を取得
        Before_Text = Select_Cell.Value
        
        '書式を取得
        '文字色
        Before_Font_Color = Select_Cell.Font.Color
        'フォント
        Before_Font = Select_Cell.Font.Name
        'フォントスタイル
        Before_FontStyle = Select_Cell.Font.FontStyle
        'フォントサイズ
        Before_FontSize = Select_Cell.Font.Size
        '下線
        Before_Underline = Select_Cell.Font.Underline

        'セルの文字列を一文字ずつ判定、取り消し線がついていなかったら文字を変数に格納する
        For i = 1 To Len(Before_Text)
            If Select_Cell.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                After_Text = After_Text & Mid(Before_Text, i, 1)
            End If
        Next i

        '取り消し線を削除した文字列を書き込む
        Select_Cell.Value = After_Text

        '書式を再設定
        '文字色
        Select_Cell.Font.Color = Before_Font_Color
        'フォント
        Select_Cell.Font.Name = Before_Font
        'フォントスタイル
        Select_Cell.Font.FontStyle = Before_FontStyle
        'フォントサイズ
        Select_Cell.Font.Size = Before_FontSize
        '下線
        Select_Cell.Font.Underline = Before_Underline

        '背景色フラグが立っていたら背景色を変更する
        If Color_Flag = True Then

            '文字列を削除したセルの背景色を変える
            If Len(Before_Text) <> Len(After_Text) Then

                Select_Cell.Interior.Color = RGB(Color_R, Color_G, Color_B)

            End If
        End If

    Next Select_Cell

    '描画などの無効化を解除
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

説明

「背景色変更フラグを初期化」の部分で、文字列を削除したセルの背景色を変更するかを指定します。

変数「Color_Flag」の値を「True」に設定すると背景色を変更、「False」で変更しません。

「選択したセル内をループ」の部分で、セルを一つ一つ確認していきます。

「書式を取得」の部分で、編集前の書式を取得しておいて、取り消し線の処理をした後「書式を再設定」の部分で書式を再設定しています。

なるべく書式を維持するための処理ですが、この処理を入れると処理時間が格段に長くなるので必要なければ削除してください。

メイン処理は、セル内の文字列を一文字ずつ判定して、取り消し線がついていない文字だけを結果反映用の変数「After_Text」に格納します。

セル内のすべての文字をチェックした後、変数「After_Text」をセルに書き戻して1セル分の削除処理が完了です。

削除処理後、変数「Color_Flag」を「True」にしていた場合は「背景色フラグが立っていたら背景色を変更する」の部分で処理前後の文字列の長さを比較して、差があれば背景色を変更します。

ユーザフォームで設定を変更できるようにする

背景色を変更するか否か、背景色の色などを実行の度にユーザフォームで設定したい場合は、次のようにします。

まず、ユーザフォームからの設定値を取得するためにグローバル変数を設定します。

前述のコードの一番初め「Public Sub Delete_Strikethrough()」の前に以下を記載してください。

Public Color_Flag As Boolean
Public Color_R, Color_G, Color_B As Integer

これで背景色変更フラグの変数「Color_Flag」とRGB値が、ユーザフォームと受け渡し可能になります。

次にユーザフォームを呼び出すための編集です。

    '背景色を変更する際の色 ※RGB値で指定
    Color_R = 255
    Color_G = 180
    Color_B = 40

この部分をユーザフォームの呼び出しに変更します。

    'ユーザーフォーム呼び出し
    UserForm1.Show

ユーザフォームは、背景色を変更する・しないのラジオボタンとR・G・Bそれぞれの値の設定用の3つのテキストボックスを作成します。

[OK]ボタンと[キャンセル]ボタンもつけて、以下のコードを設定します。

'[OK]ボタン押下時の動作とエラーチェック
Private Sub CommandButton1_Click()

    'エラーフラグを初期化
    Error_Flag = 0

    'テキストボックスの値を取得
    If TextBox1.Value >= 0 And TextBox1.Value <= 255 Then
        Color_R = TextBox1.Value
    Else
        Error_Flag = 1
    End If

    If TextBox2.Value >= 0 And TextBox2.Value <= 255 Then
        Color_G = TextBox2.Value
    Else
        Error_Flag = 1
    End If

    If TextBox3.Value >= 0 And TextBox3.Value <= 255 Then
        Color_B = TextBox3.Value
    Else
        Error_Flag = 1
    End If

    If Error_Flag = 0 Then
        'ユーザフォームを閉じてメイン処理に戻る
        Unload UserForm1
    Else
        'エラー表示
        MsgBox ("RGB値には0～255の値を設定してください。")
    End If

End Sub

'[キャンセル]ボタン押下時の動作
Private Sub CommandButton2_Click()
    '処理を終了する
    End
End Sub

'ラジオボタンで背景色を変更しない方を選択したしたときの動作
Private Sub OptionButton1_Click()

    '背景色を変更フラグをFalseにする
    Color_Flag = False
    
    'RGBのテキストボックスをグレーアウトする
    TextBox1.Enabled = False
    TextBox1.BackColor = &H808080
    TextBox2.Enabled = False
    TextBox2.BackColor = &H808080
    TextBox3.Enabled = False
    TextBox3.BackColor = &H808080
    
End Sub

'ラジオボタンで背景色を変更する方を選択したときの動作
Private Sub OptionButton2_Click()

    '背景色を変更フラグをTrueにする
    Color_Flag = True
    
    'RGBのテキストボックスをアクティブにする
    TextBox1.Enabled = True
    TextBox1.BackColor = &HFFFFFF
    TextBox2.Enabled = True
    TextBox2.BackColor = &HFFFFFF
    TextBox3.Enabled = True
    TextBox3.BackColor = &HFFFFFF

End Sub

'ユーザフォーム展開時の初期値
Private Sub UserForm_Initialize()
    '初期値
    OptionButton1.Value = True
    TextBox1.Value = 255
    TextBox2.Value = 180
    TextBox3.Value = 40
    
    'テキストボックスをグレーアウトする
    TextBox1.Enabled = False
    TextBox1.BackColor = &H808080
    TextBox2.Enabled = False
    TextBox2.BackColor = &H808080
    TextBox3.Enabled = False
    TextBox3.BackColor = &H808080
    
End Sub

'[×]ボタンでフォームを閉じさせない
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
    End If
End Sub

これで、ユーザフォームから背景色の変更をするか否か設定可能になりました。

使い方

ソースコードを保存したファイルとは異なるブックに対して使うことを想定しています。

使い方は以下の流れになります。

  1. このソースコードを保存したファイルを開く
  2. 操作したいブックを開き、取り消し線の処理をしたい範囲を選択状態にする
  3. 操作したいブックが最前面にある状態でメニューバーから[開発]-[マクロ]を選択するか Alt + F8 キー
  4. 展開したマクロのダイアログで「Delete_Strikethrough」を選択して[実行]ボタンを押下
  5. （ユーザフォームを作成したなら）展開したユーザフォームで背景色の処理を選択して[OK]ボタンを押下

ソースコードの記載されたブックではなく、操作したいブックからコードを実行する必要があります。

選択範囲については、連続しない複数の範囲選択でも動作可能です。

この記事を書いた人

ai

散歩とひなたぼっこが好きです。
自然の美しさや季節の移り変わりを感じながら、のんびりとした時間を過ごすのが日々の楽しみになっています。

Excel VBA
Happy info Spot
Happy info Spot