質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
87.20%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

解決済

Excel VBAで塗りつぶしの高速化

zzzTKG
zzzTKG

総合スコア7

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

2回答

0評価

0クリップ

454閲覧

投稿2022/01/19 15:37

前提・実現したいこと

下記のコードの高速化を図りたいです.
現状,実行すると7秒程度で完了しますが,興味本位でExcelでRPGを作ろうと思っており,画面更新の際に逐一7秒かかっていては歩くのもままなりません.
更新の際に変更部分だけ塗りつぶしを変えるように書けば速くはなると思うのですが,様々なパターンが予想される以上,都度全体を更新する方がプログラムとしては書きやすいです.
遅くとも0.5秒くらいには短縮したいところです.
仮に0.5秒としますと,mainの繰り返し処理16×16,FillBoxの繰り返し(塗りつぶし)処理32×32なので1回の塗りつぶし(コメントアウト下)が0.00000191秒(262144回の塗りつぶしを0.5秒)となります.Timerで安定して計測できた呼び出し部(コメントアウト上)で,0.027秒程度でした.全体の実行を0.5秒とするには,この部分を0.002秒程度にする必要があり,FillBoxの処理を10倍程速くしたいです.
高速化の妙案ございますでしょうか?

実行の際の注意

下記コードを実行して頂く場合,シート全体を1ピクセル×1ピクセルにしてからお願い致します.
添付写真のように32×32サイズのドット文字を16×16枚出力しています.

イメージ説明

VBA(Excel)

Option Explicit Sub main() Application.ScreenUpdating = False Dim i As Long Dim j As Long Dim T As Double For i = 0 To 15 For j = 0 To 15 T = Timer Call FillBox("あ", "black", Range("B2").Offset(i * 32, j * 32)) '''0.027-0.028秒かかっている Debug.Print Timer - T Next j Next i Application.ScreenUpdating = True End Sub Sub FillBox(str As String, back As String, pos As Range) Dim map(31, 31) As Long Dim i As Long Dim j As Long Select Case back Case "black" For i = 0 To 31 For j = 0 To 31 map(j, i) = RGB(0, 0, 0) Next j Next i End Select Select Case str Case "あ" For i = 11 To 13 For j = 2 To 6 map(j, i) = RGB(255, 255, 255) Next j For j = 10 To 13 map(j, i) = RGB(255, 255, 255) Next j For j = 20 To 21 map(j, i) = RGB(255, 255, 255) Next j For j = 25 To 26 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 8 To 21 For j = 7 To 9 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 17 To 19 For j = 12 To 13 map(j, i) = RGB(255, 255, 255) Next j For j = 17 To 21 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 11 To 21 For j = 14 To 16 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 8 To 13 For j = 17 To 19 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 22 To 24 For j = 17 To 26 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 6 To 8 For j = 20 To 26 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 11 To 16 For j = 22 To 24 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 8 To 10 For j = 27 To 29 map(j, i) = RGB(255, 255, 255) Next j Next i For i = 17 To 21 For j = 27 To 29 map(j, i) = RGB(255, 255, 255) Next j Next i Case Else End Select Dim R As Long Dim C As Long For R = 0 To 31 For C = 0 To 31 pos.Offset(R, C).Interior.Color = map(R, C) '''塗りつぶし1回 Next C Next R End Sub

参考

こちらのサイト
https://excel.syogyoumujou.com/vba/speed_up.html
で塗りつぶしの高速化が検証されていますが,Test_6のような高速化を上記のコードにも適用可能でしょうか?

環境

プロセッサ:AMD Ryzen 7 3700X 8-Core Processor 3.59 GHz
実装RAM:16.0 GB
OS:Windows 10 Pro
Excelバージョン:2016

良い質問の評価を上げる

以下のような質問は評価を上げましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

  • プログラミングに関係のない質問
  • やってほしいことだけを記載した丸投げの質問
  • 問題・課題が含まれていない質問
  • 意図的に内容が抹消された質問
  • 過去に投稿した質問と同じ内容の質問
  • 広告と受け取られるような投稿

評価を下げると、トップページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

まだ回答がついていません

会員登録して回答してみよう

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
87.20%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。