Excel VBA 選択範囲の罫線色の変更プロージャの動作速度の改善について

次はエクセルで既に設定されている罫線の色を一括変更するプロージャーですが、表形式のシートで実行してみると結構動作が遅いです。高速化できますか？

Sub 罫線色変更()
Application.ScreenUpdating = False
Dim r As Range
Dim i As Long
Application.Dialogs(xlDialogEditColor).Show (1)
For Each r In Selection
For i = 7 To 10
If r.Borders(i).LineStyle <> xlNone Then
r.Borders(i).Color = ActiveWorkbook.Colors(1)
End If
Next i
Next r
Application.ScreenUpdating = True
End Sub

No.9 ベストアンサー 回答者： ママチャリ 回答日時： 2024/07/13 16:33

RangeをFor Eachでループしているように、BorderもFor Eachでループした方が早いと思います。

実際にやってみて、処理時間を報告して頂けると嬉しいです。その際、選択した（処理した）行列数もよろしくです。

この回答へのお礼

回答ありがとうございます。
ご助言のとおり処理時間が過去１番早くなりました！
よろしければ、その理屈を教えていただけると嬉しいです。

参考までに、13万個のセルの表罫線について処理した結果は「７秒」でした。
※先の回答者様の、隣合うセルの共通罫線の走査の無駄を排除した場合のコードでは９秒
※罫線色 = ActiveWorkbook.Colors(1) の工夫による処理速度の向上は僅かでした
※何も工夫しないこのQAの最初のコードは１５秒



Sub 罫線色変更その4() ' For Each obj In r.Borders作戦
Dim start As Variant, finish As Variant
start = Time
Application.ScreenUpdating = False

Dim 罫線色 As Double
Application.Dialogs(xlDialogEditColor).Show (1)
罫線色 = ActiveWorkbook.Colors(1)

Dim r As Range
Dim obj As Object
For Each r In Selection
For Each obj In r.Borders
If obj.LineStyle <> xlNone Then obj.Color = 罫線色
Next obj
Next r

Application.ScreenUpdating = True
finish = Time
MsgBox Format(finish - start, "nn分ss秒")
Debug.Print Format(finish - start, "nn分ss秒")
End Sub

お礼日時：2024/07/13 21:48

No.8 回答者： いんちょ 回答日時： 2024/07/10 18:02

各セルについて上下左右の罫線をチェックされていますが、それだと同じ罫線を重複してチェックすることになります。

上と左だけチェックして、右端と下端のセルだけ右と下の罫線をチェックするようにすれば、時間は半分強になるかと思います。

この回答へのお礼

回答ありがとうございます。
なるほど！二重チェックの無駄が省けますね。
検証してみると、教えていただいたとおり処理時間が短縮されました。
うれしいです！

お礼日時：2024/07/13 21:05

No.7 回答者： tatsumaru77 回答日時： 2024/07/10 17:41

No4です。

>表形式のシートで実行してみると結構動作が遅いです。
表形式のシートということなので、No4のように
「選択範囲のすべてのセルが全く等しく罫線をもっている」という前提かと思いましたが、前提が違うようですね。

＞今回は、各セルの罫線の状態が異なる場合を想定していました。
ということなので、役に立たないかもしれませんが、
「選択範囲のすべてのセルが全く等しく罫線をもっている」場合のマクロです。
以下のようにしてください。

Sub 罫線色変更()
Application.ScreenUpdating = False
Application.Dialogs(xlDialogEditColor).Show (1)
Selection.Borders.Color = ActiveWorkbook.Colors(1)
Application.ScreenUpdating = True
End Sub

この回答へのお礼

回答ありがとうございます。

「表形式」という言葉から想像を巡らしていただきありがとうございました。表形式ではありますが、異種の罫線が混じっていることを想定しておりました。

コードをご紹介していただきありがとうございました。

お礼日時：2024/07/13 20:35

No.6 回答者： Qchan1962 回答日時： 2024/07/10 09:28

＞colr ですが、Double型にする必要はありますか？

独学なので習慣というか・・確か？どこかで覚えたような気がする程度です

少し調べました　と言いてもVBEのオブジェクトブラウザーで
Excelライブラリ　Bordersクラスの　Colorメンバーで見ると

Property Color As Variant
Excel.Borders のメンバー

とあります　という事は　Variant　ですね
これは取得できなかった時にEmptyを返す必要があるのかもしれません？

簡単に確かめると
Sub a()
Dim c As Variant
c = Range("A1").Borders(7).Color
Debug.Print TypeName(c)　'Double
End Sub

Doubleと出力されます
Variant/Double　なのですね

必要があるかはわかりません
ただ、処理速度という意味ではVariant型は使わない方が良いというのも
昔どこかで見た覚えがありますのでAs Double　としました

あやふやな情報（記憶）になりますので確認が必要と思います

この回答へのお礼

回答ありがとうございます。

お時間をさいてTypeを調べ、その調べたコードまでご紹介いただきありがとうございました。当方でもVBEで上記コードを試し、Doubleとなることを確認いたしました。

ありがとうございます。

お礼日時：2024/07/13 20:32

No.5 回答者： Qchan1962 回答日時： 2024/07/08 19:07

こんばんは　既にある回答と重複いたしますが

Selectionの形状とLineの有無の形で処理を短絡（範囲を一度に設定）できない状態になりますので　複雑な状態（ランダムな選択範囲と飛び飛びな罫線）での処理手順は　示されているような手順になるかと思います

ご質問に示されているコードで少しでもという事でしたら
＃３様が回答されている事とオブジェクトなのでWith でくくり　さらに
条件（同色の場合の処理をしない）を増やすくらいでしょうか・・・
早くなるといってもわずか　かも

Dim r As Range
Dim i As Long
Dim colr As Double
Application.Dialogs(xlDialogEditColor).Show (1)
colr = ActiveWorkbook.Colors(1)
Application.ScreenUpdating = False
For Each r In Selection
For i = 7 To 10
With r.Borders(i)
If .LineStyle <> xlNone Then
If .Color <> colr Then .Color = colr
End If
End With
Next i
Next r
Application.ScreenUpdating = True

この回答へのお礼

回答ありがとうございます。
Withステートメントについても反映してみました。劇的な処理速度の向上にはなっていませんが、Withステートメントによって処理が高速化するといくインターネトの記事もありましたので、新たな気づきになりました。

colr ですが、Double型にする必要はありますか？

お礼日時：2024/07/10 03:50

No.4 回答者： tatsumaru77 回答日時： 2024/07/07 19:07

No2です。

「選択範囲のすべてのセルが全く等しく罫線をもっている」という解釈です。
添付図の左側の場合は、A1:C10が選択されている前提です。
添付図の右側の場合は、F3:H9が選択されている前提です。

この回答へのお礼

ありがとうございます。
今回は、各セルの罫線の状態が異なる場合を想定していました。
すべて同じ罫線ならVBAを使うまでもないのでは？と最初感じましたが、慎重に考えてみると、同じ罫線だったとしてもVBAを用いた方がよいことがあると考えました。参考にいたします。

お礼日時：2024/07/10 03:48

No.3 回答者： bonaron 回答日時： 2024/07/07 18:47

> ActiveWorkbook.Colors(1)

これを変数に代入して だけ参照するようにすれば
かなり速くなると思われます。

Dim col As Long
Application.Dialogs(xlDialogEditColor).Show (1)
col = ActiveWorkbook.Colors(1)
For Each r In Selection
For i = 7 To 10
If r.Borders(i).LineStyle <> xlNone Then
r.Borders(i).Color = col

この回答へのお礼

回答ありがとうございます。
教えていただいたとおりにコードを修正しました。
「かなり」とまではいきませんが、少し処理が早くなった印象があります。
ありがとうございます。

お礼日時：2024/07/10 03:46

No.2 回答者： tatsumaru77 回答日時： 2024/07/07 10:34

現在のマクロは、選択された範囲内のセルの罫線の有無を判定し、罫線がある場合に、色付けを行っています。

もし、選択された範囲には必ず罫線があるものとして、色付けを行ってよいなら、高速化は可能です。

その場合は、罫線がある範囲を選択してマクロを実行することになりますが、いかがでしょうか。それで良ければ、マクロの提供は可能です。

この回答へのお礼

回答ありがとうございます。
「罫線がある」について詳しく教えてください。
セルには、上下左右や対角線などの罫線がありますが、「選択した範囲のいずれかのセルについて、いずれかの罫線が少なくとも１つ存在する」という解釈でしょうか？それとも、「選択範囲のすべてのセルが全く等しく罫線をもっている」という解釈でしょうか？

お礼日時：2024/07/07 18:27

No.1 回答者： fujillin 回答日時： 2024/07/06 19:25

こんばんは

簡単にテストしてみましたが・・

VBAで時間がかかる原因のひとつに、シート情報へのアクセスがあります。
罫線の有無をチェックせずに、色をまとめてセットするだけで上手く行かないかと思いましたが、罫線が設定されていない部分にまで罫線が引かれてしまうようで、どうやら、ご提示のように一つ一つの罫線をチェックして設定せざるを得ないようですね。

とはいえ、対象が表であるなら、隣接するセル間の罫線を重複して2回処理していることになりますので、2辺だけをチェックするロジックに変えればだいぶ速くできそうであろうと考えてみました。
上記でチェックできない外側の2辺（＝1行と1列分）はそれぞれ別にチェックすることになりますが、処理量が「半分+α（＝6割以下程度か？）」くらいになることが期待できます。
簡単なものでテストしてみると、期待には届かず、約6.5割くらいの処理時間（＝約3.5割減）となりました。

ただし、上記は選択が単純な矩形エリアの場合を想定していますので、複数のエリアを選択することも許容する場合には、処理のロジックとして、エリア毎に処理するようにしないと上手くいきません。（Area属性は矩形なので）
こちらの場合でも大きくは変わらないと思いますが、もう少し時間がかかる可能性はあります。

速度は大幅には向上しませんけれど、多少なりとも速くはなりますので、ご参考までに。

この回答へのお礼

回答ありがとうございます。
「シート情報のアクセスに時間がかかる」は覚えておきたいな、と参考になりました。今回の処理の高速化について、根本的な解決法は難しい（無いかもしれない）のですね。判定の重複を避けて効率化する視点は参考になります。数十パーンセントの時間の削減　と　コードの可読性　のどちらを優先するかを考えていきます。

お礼日時：2024/07/07 03:13