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:
[download id=”1178″]

Klikni a stahuj!