Jak vytvářet teplotní i jiné mapy

Ať už se díváte na rozložení teplot mapy ČR, zpracováváte model rozložení napětí s pomocí Metody konečných prvků nebo měříte elektromagnetické vlastnosti, potkáváte se s barevnými mapami. Ne, nebojte se, na tomto místě nehrozí žádný matematicko-fyzikální rozbor. Nám půjde o jinou věc – simulaci plošné mapy v prostředí Excelu.

V Excelu se můžeme vydat třemi cestami.

Povrchový (obrysový graf)

Mějme dvourozměrnou oblast o velikosti 20 x 20 buněk. Inspirací mi byl model RNDr. Ctibora Henzla a jeho příkladu z oblasti elektromagnetismu (pokud se pamatuji, jedná se o chování dielektrika určitého tvaru v elektrickém poli). Hodnoty zde uvedené jsou zadány přímo, abych neprozrazoval „know-how“ výpočtů. V daném modelu je totiž hodnota buňky závislá na okolních a je třeba se zamyslet nad cyklickými odkazy, iteracemi, … Mně osobně činilo problémy takový model dokázat nastartovat a oživovací proces připomínal spíš probouzení Golema. Zpátky ale k dětským hrám a „barvičkování“. První se nabízí povrchový (obrysový) graf.

Barevná mapa - povrchový graf — Barevná mapa – povrchový graf

Je vidět, že výsledek není ideální, ať už z pohledu vykreslování či barevnosti. Ani další nabízené styly těchto grafů nepočítají s barvami, na které jsme zvyklí, a jejich nahrazování ručně je neskutečná piplačka. Pokud na dané cestě chcete zůstávat, doporučuji sáhnout po VBA.

Obarvení buněk podmíněných formátem

Tato stezka je vyšlapaná i pro začátečníky a zvládne ji prakticky každý. Obarvení proběhne přímo na buňkách a postará se o něj průvodce v Podmíněném formátování. Ještě než jej aplikujete, doporučuji skrýt obsah buněk vlastním formátem ;;; (tři středníky). Když se později budete chtít podívat na hodnotu, přečtete ji v Řádku vzorců. Rastr buněk je čtvercový (buď se řiďte rozměry v pixelech nebo se přepněte do zobrazení Rozložení stránky).

Barevná mapa - podmíněný formát — Barevná mapa – podmíněný formát

U tohoto způsobu nevím, jestli jej doporučit jako číslo jedna nebo ne. První zdržení mohou v praxi představovat zmíněné výpočty vzorců v buňkách, které je poté nutno zpracovat podmíněným formátem… Na menším množství dat a při statických hodnotách je ale tento způsob rychlý. Navíc můžeme definovat vlastní barvy a hranice přechodů hodnotou, procentuálně, či vzorcem.

Obarvení buněk s pomocí VBA

Excel má přirozeně nejblíže k barevnému spektru reprezentovanému barvami červená-zelená-modrá (red-green-blue, RGB). Každá z nich nabývá hodnot 0-255. Čistá červená je tak zapsaná jako RGB(255, 0, 0). Jak na to ve VBA? V oblasti buněk najdeme minimální a maximální hodnotu (krajní hodnoty). V RGB modelu si vybereme dvě čisté barvy odpovídající krajním hodnotám a nastudujeme/vyzkoušíme si, jak musíme míchat složky barev, abychom docílili pěkného přechodu (modrá přes bílou do červené, zelená přes žlutou do červené apod.). Počet barev je v daném případě limitován v podstatě číslem 512 (256 z jedné čisté barvy do přechodové barvy a 256 z přechodové barvy do druhé čisté barvy). Do intervalu 1-512 barev pak musíme promítnout skutečné naměřené hodnoty (přepočty už byly řešeny v článku Více jak dvě svislé osy v grafu). Barvy ve VBA míchá funkce RGB a její výsledek přiřazujeme do vlastnosti .Interior.Color každé z buněk.

Barevná mapa - VBA (modrá-červená) — Barevná mapa – VBA (modrá-červená)

Barevná mapa - VBA (modrá-žlutá-červená) — Barevná mapa – VBA (modrá-žlutá-červená)

Barevná mapa - VBA (zelená-žlutá-červená) — Barevná mapa – VBA (zelená-žlutá-červená)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

Private Const cstrOblast As String = "A1:T20"

Sub Spektrum2_ModraCervena()

Dim i As Integer
Dim aPoleRGB(1 To 256, 1 To 3) As Integer
Dim rngBunka As Range
Dim rngOblast As Range

'Const intMinX As Integer = 0
'Const intMaxX As Integer = 100

Const intMinY As Integer = 0
Const intMaxY As Integer = 255

Set rngOblast = Range(cstrOblast)

For i = 0 To 255

aPoleRGB(i + 1, 1) = i
aPoleRGB(i + 1, 2) = 0
aPoleRGB(i + 1, 3) = 255 - i

Next i

intMinX = WorksheetFunction.Min(rngOblast)
intMaxX = WorksheetFunction.Max(rngOblast)

Application.ScreenUpdating = False

For Each rngBunka In rngOblast

x = rngBunka.Value

y = CInt((intMaxY - intMinY) / (intMaxX - intMinX) * (x - intMinX) + intMinY)

rngBunka.Interior.Color = RGB(aPoleRGB(y + 1, 1), aPoleRGB(y + 1, 2), aPoleRGB(y + 1, 3))

Next rngBunka

Application.ScreenUpdating = True

End Sub

Sub Spektrum3_ModraZlutaCervena()

Dim i As Integer
Dim aPoleRGB(1 To 512, 1 To 3) As Integer
Dim rngBunka As Range
Dim rngOblast As Range

'Const intMinX As Integer = 0
'Const intMaxX As Integer = 100

Const intMinY As Integer = 1
Const intMaxY As Integer = 512

Set rngOblast = Range(cstrOblast)

For i = 0 To 255

aPoleRGB(i + 1, 1) = i
aPoleRGB(i + 1, 2) = i
aPoleRGB(i + 1, 3) = 255 - i

Next i

For i = 0 To 255

aPoleRGB(i + 257, 1) = 255
aPoleRGB(i + 257, 2) = 255 - i
aPoleRGB(i + 257, 3) = 0

Next i

intMinX = WorksheetFunction.Min(rngOblast)
intMaxX = WorksheetFunction.Max(rngOblast)

Application.ScreenUpdating = False

For Each rngBunka In rngOblast

x = rngBunka.Value

y = CInt((intMaxY - intMinY) / (intMaxX - intMinX) * (x - intMinX) + intMinY)

rngBunka.Interior.Color = RGB(aPoleRGB(y, 1), aPoleRGB(y, 2), aPoleRGB(y, 3))

Next rngBunka

Application.ScreenUpdating = True

End Sub

Sub Spektrum3_ZelenaZlutaCervena()

Dim i As Integer
Dim aPoleRGB(1 To 512, 1 To 3) As Integer
Dim rngBunka As Range
Dim rngOblast As Range

'Const intMinX As Integer = 0
'Const intMaxX As Integer = 100

Const intMinY As Integer = 1
Const intMaxY As Integer = 512

Set rngOblast = Range(cstrOblast)

For i = 0 To 255

aPoleRGB(i + 1, 1) = i
aPoleRGB(i + 1, 2) = 128
aPoleRGB(i + 1, 3) = 0

Next i

For i = 0 To 255

aPoleRGB(i + 257, 1) = 255
aPoleRGB(i + 257, 2) = 128 - i \ 2
aPoleRGB(i + 257, 3) = 0

Next i

intMinX = WorksheetFunction.Min(rngOblast)
intMaxX = WorksheetFunction.Max(rngOblast)

Application.ScreenUpdating = False

For Each rngBunka In rngOblast

x = rngBunka.Value

y = CInt((intMaxY - intMinY) / (intMaxX - intMinX) * (x - intMinX) + intMinY)

rngBunka.Interior.Color = RGB(aPoleRGB(y, 1), aPoleRGB(y, 2), aPoleRGB(y, 3))

Next rngBunka

Application.ScreenUpdating = True

End Sub

Příloha:
excel_spektra.zip

Uložit článek jako PDF