読者です 読者をやめる 読者になる 読者になる

小池イーサンだお(^O^)/

読んでーーーー

取消線のついた文字を削除するためのエクセルマクロを頑張って改良したはなし

オッス、オラ小池イーサン( `ー´)ノ

この記事で作ったマクロを改良するよーーーー(^O^)/
koike-e3.hatenablog.jp

とりあえずやりたいことはできた。
けれど処理がめっちゃ遅いんだよね( ;∀;)
だから少しでも速くするためにどうすればいいか考えてみるよ(^_-)-☆

処理時間を測定しよう

次のようなシートを処理します。
f:id:koike_e3:20161013222703p:plain
・見出し行(3セル)
・セル内の部分的に取消線を施した列(10セル)
・セル全体に取消線を施した列(10セル)
・何もしていない列(10セル)
の計33セルを範囲指定して3回実行してみます。
なお、処理時間の測定は次のように行います。

Sub 取消線を削除する2()
    procStart = Timer
   ' 処理
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub

前回の成果物

現状を把握します。

Sub 取消線を削除する2()
    procStart = Timer
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '取消線のついていない文字を結合していく変数の初期化
        temp = ""
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていればtempに結合
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                '末尾から調べているので先頭に結合していく
                temp = Mid(moji.Value, i, 1) & temp
            End If
        Next i
        moji.Value = temp
    Next moji
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub
結果

18.6123sec
18.77051sec
19.83301sec

型を宣言してみよう

とりあえず動けばいいやと書いたので、変数の型が宣言がされていません。(ゆるふわ言語の良さ)
それぞれ型を宣言して実行してみましょう。

Sub 取消線を削除する2()
    '型宣言
    Dim moji As Object, temp As String, i As Long
    Dim procStart As Double, procEnd As Double
    procStart = Timer
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        '取消線のついていない文字を結合していく変数の初期化
        temp = ""
        'セル内の文字列を末尾から先頭に向かって調べていく
        For i = Len(moji.Value) To 1 Step -1
            'ひと文字ずつ判定し、取消線がついていればtempに結合
            If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                '末尾から調べているので先頭に結合していく
                temp = Mid(moji.Value, i, 1) & temp
            End If
        Next i
        moji.Value = temp
    Next moji
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub
結果

19.146484375sec
18.8232421875sec
18.685546875sec

変わりませんね。

文字の結合方法を変えよう

「+」だとか「&」で結合するたびにメモリを確保しなおす(新しいオブジェクトが作成される?)
から効率が悪いってのが他言語でも常識なわけです。
VBAではどうするのか探してみました。
文字列を高速に連結する(Midステートメント):Excel VBA|即効テクニック|Excel VBAを学ぶならmoug
Excel VBA:高速化 > ループ内:文字列に追加連結しない - YiaoWang
マクロ高速化 - 文字列結合
が、ソレ用のクラスがあるわけではないようで、
どれも可読性を悪くするか領域の動的な確保がアレなのでパス。
うまくできませんかね。

セル単位で処理の要否を判断しよう

本命です。
これまではすべての文字に対して取消線がついているか否かを見てきました。
が、実際に取消線を付けようとするとき
①セル全体に対して取消線を施す
②セル内の文字列の一部に取消線を施す
③なにもしない

の3パターンが考えられます。
このパターンに応じて処理する・しないを分岐させるとうまくいきそうです。
「①セル全体に対して取消線を施す」だった場合、
即セル内の文字列をすべて削除できるため処理が速くなるはずです。
「②セル内の文字列の一部に取消線を施す」だった場合、
いままで通りに処理するしかないでしょう。
「③なにもしない」だった場合、
なにも処理せず次のセルを見に行くようにすれば処理が速くなるはずです。
実務では①はあまりないかもしれませんが...(全部に取消線を施すよりもセルをグレーダウンしそう)

で、パターンをどう見分けるかですが、
「セル.Font.Strikethrough」が次のように返ってきたのでそれを利用します。
①セル全体に対して取消線を施す
⇒セル.Font.Strikethrough = True
②セル内の文字列の一部に取消線を施す
⇒セル.Font.Strikethrough = Null
③なにもしない
⇒セル.Font.Strikethrough = False

以上を反映させます。
と、いきたかったんですが、

Case Null

とするとCase句の中身を実行してくれなかったので

Case Else

としました(なぜ動かないんだ??????)

Sub 取消線を削除する2()
    '型宣言
    Dim moji As Object, temp As String, i As Long
    Dim procStart As Double, procEnd As Double
    procStart = Timer
   ' 範囲選択されたセルを処理していく
    For Each moji In Selection.Cells
        'Debug.Print moji.Font.Strikethrough
        'セルの属性で条件分岐
        Select Case moji.Font.Strikethrough
            'セル全体に取消線の場合
            Case True
                'Debug.Print "Case True"
                moji.Value = ""
            'なにもなしの場合
            Case False
                'Debug.Print "Case False"
            'セル内の一部分に取消線の場合
            Case Else
                'Debug.Print "Case Else"
                '取消線のついていない文字を結合していく変数の初期化
                temp = ""
               'セル内の文字列を末尾から先頭に向かって調べていく
                For i = Len(moji.Value) To 1 Step -1
                    'ひと文字ずつ判定し、取消線がついていればtempに結合
                    If moji.Characters(Start:=i, Length:=1).Font.Strikethrough = False Then
                        '末尾から調べているので先頭に結合していく
                        temp = Mid(moji.Value, i, 1) & temp
                    End If
                Next i
                moji.Value = temp
        End Select
    Next moji
    procEnd = Timer
    Debug.Print procEnd - procStart & "sec"
End Sub
結果

6.6962890625sec
6.6865234375sec
6.7529296875sec

圧倒的成長!!!!!!!!!

これでやっと実務で使えるレベル(で保守もしやすい)マクロになったやんな(*‘ω‘ *)


今回は処理の要否で分岐させて速くできました。
Case句の中身自体が工夫できればいいのですが( ;∀;)