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

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

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

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

Q&A

解決済

2回答

2908閲覧

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

zzzTKG

総合スコア7

VBA

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

0グッド

0クリップ

投稿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)

1Option Explicit 2Sub main() 3Application.ScreenUpdating = False 4Dim i As Long 5Dim j As Long 6Dim T As Double 7 For i = 0 To 15 8 For j = 0 To 15 9 T = Timer 10 Call FillBox("あ", "black", Range("B2").Offset(i * 32, j * 32)) '''0.027-0.028秒かかっている 11 Debug.Print Timer - T 12 Next j 13 Next i 14Application.ScreenUpdating = True 15End Sub 16Sub FillBox(str As String, back As String, pos As Range) 17Dim map(31, 31) As Long 18Dim i As Long 19Dim j As Long 20 Select Case back 21 Case "black" 22 For i = 0 To 31 23 For j = 0 To 31 24 map(j, i) = RGB(0, 0, 0) 25 Next j 26 Next i 27 End Select 28 Select Case str 29 Case "あ" 30 For i = 11 To 13 31 For j = 2 To 6 32 map(j, i) = RGB(255, 255, 255) 33 Next j 34 For j = 10 To 13 35 map(j, i) = RGB(255, 255, 255) 36 Next j 37 For j = 20 To 21 38 map(j, i) = RGB(255, 255, 255) 39 Next j 40 For j = 25 To 26 41 map(j, i) = RGB(255, 255, 255) 42 Next j 43 Next i 44 For i = 8 To 21 45 For j = 7 To 9 46 map(j, i) = RGB(255, 255, 255) 47 Next j 48 Next i 49 For i = 17 To 19 50 For j = 12 To 13 51 map(j, i) = RGB(255, 255, 255) 52 Next j 53 For j = 17 To 21 54 map(j, i) = RGB(255, 255, 255) 55 Next j 56 Next i 57 For i = 11 To 21 58 For j = 14 To 16 59 map(j, i) = RGB(255, 255, 255) 60 Next j 61 Next i 62 For i = 8 To 13 63 For j = 17 To 19 64 map(j, i) = RGB(255, 255, 255) 65 Next j 66 Next i 67 For i = 22 To 24 68 For j = 17 To 26 69 map(j, i) = RGB(255, 255, 255) 70 Next j 71 Next i 72 For i = 6 To 8 73 For j = 20 To 26 74 map(j, i) = RGB(255, 255, 255) 75 Next j 76 Next i 77 For i = 11 To 16 78 For j = 22 To 24 79 map(j, i) = RGB(255, 255, 255) 80 Next j 81 Next i 82 For i = 8 To 10 83 For j = 27 To 29 84 map(j, i) = RGB(255, 255, 255) 85 Next j 86 Next i 87 For i = 17 To 21 88 For j = 27 To 29 89 map(j, i) = RGB(255, 255, 255) 90 Next j 91 Next i 92 Case Else 93 End Select 94Dim R As Long 95Dim C As Long 96 For R = 0 To 31 97 For C = 0 To 31 98 pos.Offset(R, C).Interior.Color = map(R, C) '''塗りつぶし1回 99 Next C 100 Next R 101End 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

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

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

もっと良い方法があるかもしれないですが、
同じパターンのデータを使って良いのであれば、部品として用意しておき、コピー&ペーストで配置するのが手軽ではないかと思います。
試した所、30倍に高速化することを確認しました。

変更前)約6.1秒
変更後)約0.2秒

■ イメージ
イメージ説明
map … 出力先のシート
asset … 部品用のシート

■ コード

vba

1Option Explicit 2 3Sub main() 4 Application.ScreenUpdating = False 5 6 ' 部品を用意 7 Call InitAsset("asset", 0, "■", "black") 8 Call InitAsset("asset", 1, "あ", "black") 9 10 ' 部品を選択 11 Call SelectAsset("asset", 1) 12 13 Worksheets("map").Activate 14 15 Dim i As Long 16 Dim j As Long 17 Dim T As Double 18 19 T = Timer 20 For i = 0 To 15 21 For j = 0 To 15 22 ' 部品をペーストで配置 23 Range("B2").Offset(i * 32, j * 32).PasteSpecial 24 Next 25 Next 26 Debug.Print Timer - T 27 28 Application.ScreenUpdating = True 29End Sub 30 31Sub InitAsset(sheetName As String, index As Long, str As String, back As String) 32 Dim pos 33 Set pos = Worksheets(sheetName).Range("A1").Offset(0, index * 32) 34 35 Dim map(31, 31) As Long 36 Dim i As Long 37 Dim j As Long 38 Select Case back 39 Case "black" 40 For i = 0 To 31 41 For j = 0 To 31 42 map(j, i) = RGB(0, 0, 0) 43 Next j 44 Next i 45 End Select 46 47 Select Case str 48 Case "あ" 49 For i = 11 To 13 50 For j = 2 To 6 51 map(j, i) = RGB(255, 255, 255) 52 Next j 53 For j = 10 To 13 54 map(j, i) = RGB(255, 255, 255) 55 Next j 56 For j = 20 To 21 57 map(j, i) = RGB(255, 255, 255) 58 Next j 59 For j = 25 To 26 60 map(j, i) = RGB(255, 255, 255) 61 Next j 62 Next i 63 For i = 8 To 21 64 For j = 7 To 9 65 map(j, i) = RGB(255, 255, 255) 66 Next j 67 Next i 68 For i = 17 To 19 69 For j = 12 To 13 70 map(j, i) = RGB(255, 255, 255) 71 Next j 72 For j = 17 To 21 73 map(j, i) = RGB(255, 255, 255) 74 Next j 75 Next i 76 For i = 11 To 21 77 For j = 14 To 16 78 map(j, i) = RGB(255, 255, 255) 79 Next j 80 Next i 81 For i = 8 To 13 82 For j = 17 To 19 83 map(j, i) = RGB(255, 255, 255) 84 Next j 85 Next i 86 For i = 22 To 24 87 For j = 17 To 26 88 map(j, i) = RGB(255, 255, 255) 89 Next j 90 Next i 91 For i = 6 To 8 92 For j = 20 To 26 93 map(j, i) = RGB(255, 255, 255) 94 Next j 95 Next i 96 For i = 11 To 16 97 For j = 22 To 24 98 map(j, i) = RGB(255, 255, 255) 99 Next j 100 Next i 101 For i = 8 To 10 102 For j = 27 To 29 103 map(j, i) = RGB(255, 255, 255) 104 Next j 105 Next i 106 For i = 17 To 21 107 For j = 27 To 29 108 map(j, i) = RGB(255, 255, 255) 109 Next j 110 Next i 111 Case Else 112 End Select 113 Dim R As Long 114 Dim C As Long 115 For R = 0 To 31 116 For C = 0 To 31 117 pos.Offset(R, C).Interior.Color = map(R, C) '''塗りつぶし1回 118 Next C 119 Next R 120End Sub 121 122Sub SelectAsset(sheetName As String, index As Long) 123 Worksheets(sheetName).Activate 124 Range(Cells(1, index * 32 + 1), Cells(32, index * 32 + 32)).Copy 125End Sub

投稿2022/01/19 17:12

編集2022/01/20 05:52
cx20

総合スコア4632

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

zzzTKG

2022/01/20 14:51

32×32が既に塗られているので当然速くなりますね.アセットは一般的なゲーム開発でも使われるのに思いつきませんでした... 32×32の単体だけでなく,フレームなどの組み合わせパーツなども作ってしまえば高速化に加えてコードの単純化もできそうです. 目から鱗でした.ありがとうございます.
cx20

2022/01/20 14:55

> アセットは一般的なゲーム開発でも使われる そうですね。この手の方法はマップタイルとか呼ばれたりするようです。 ■ マップタイルの仕組み | RPGツクールVX Ace 初心者向け講座 https://tkool.jp/products/rpgvxace/lecture/002_004/index.html
guest

0

使用する色の数だけ条件付き書式を設定してはどうでしょうか?
書式には塗り潰しとフォントカラーのいずれにも対象色を指定します。
そうすることで文字は背景色と同化して見えなくなります。

ロジックもセルに値を設定するだけなのでシンプルになります。

投稿2022/01/19 23:26

takanaweb5

総合スコア354

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

zzzTKG

2022/01/20 14:42

RPGの全体像が完成していれば何とか出来るかもしれないですが,どの領域にどんな色パターンが割り当てられるか確定していないことやゲーム全体の更新量を考えると少々現実的でない作業量になりそうです... ただ発想としてはアリです!今後の作業の参考にさせて頂きます.
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問