Egy egyszerűsített Score Card színezést fogok bemutatni. A Score Card-ot magyarul stratégiai mutatószám-rendszernek hívhatnánk, de itthon is gyakran az angol kifejezés használatos. Ez egyfajta összesítő, mely megmutatja, hogy a választott KPI-ok (Key Performance Indicators vagyis Kulcsfontosságú teljesítménymutatók) hol tartanak a célértékhez képest.
Az alábbi kód ezt a színezést végzi el, mégpedig figyelembe véve, hogy bizonyos KPI-oknál a nagyobb míg másoknál a kisebb érték a jobb. A söripari cégnél ahol dolgoztam a gépsori hatékonyságnál a nagyobb érték a jobb, míg az energiafelhasználásnál természetesen az alacsonyabb.
Az adott munkafüzetbe szúrjunk be egy modult a Visual Basic szerkesztőjében és az alábbi kódot adjuk hozzá:
|
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 |
Sub ScoreCard_Szinez() Dim Mit As Range, Cel As Range, i As Long, j As Long 'készítette: XLMotyo Application.ScreenUpdating = False Set Mit = Sheet1.Range("e3:g6") 'szükség esetén a tartományt frissíteni Set Cel = Sheet1.Range("d3:d6") 'szükség esetén a tartományt frissíteni Mit.Font.ColorIndex = xlAutomatic For i = 1 To Mit.Rows.Count For j = 1 To Mit.Columns.Count Select Case i Case 1 '1. sor a tartományban: nagyobb érték a jobb. Szükség esetén a sorszámot frissíteni. If Mit.Cells(i, j).Value >= Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = RGB(0, 176, 80) ElseIf Mit.Cells(i, j).Value < Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = vbRed End If Case 2 To 4 '2-4. sor a tartományban: kisebb érték a jobb. Szükség esetén a sorszámot frissíteni. If Mit.Cells(i, j).Value <= Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = RGB(0, 176, 80) ElseIf Mit.Cells(i, j).Value > Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = vbRed End If End Select Next j Next i Application.ScreenUpdating = True End Sub |
Íme a kapcsolódó videó:
Érkezett visszajelzés melyben említették, hogy a fenti színezést feltételes formázással is könnyedén meg lehet valósítani.
Ez vitathatatlan, általában egy problémára többféle megoldás is létezik. Példa:
Személy szerint nekem nem a szívem csücske a feltételes formázás az alábbiak miatt:
– rutinosnak kell lenned a használatában, különben könnyű hibát véteni (úgy mint feltételt megadni az egész munkafüzetre egy tartomány helyett) illetve sok idő megy el a kísérletezgetéssel, teszteléssel
– az Excel 2007-es verziójáig legfeljebb három feltételt lehet megadni (tudom meghökkentően hangzik de magam is tudok olyan cégekről/személyekről akik 2019-ben is még 2003-as Office-t használnak)
– könnyű felülírni a formázást tartalmazó cellákat: pl. néhány értéket másolunk (CTRL+C) majd a feltételes formását tartalmazó tartományba beillesztjük (CTR+V) és a formázás eltűnt, figyelmeztetés nélkül
– tegyük fel, hogy a formázott cellák formátumát (pl. cella háttérszín, betűszín) másolni akarjuk de a feltételes formázás szabályai nélkül. Egyszerűen hangzik, nemde? Hát nem az. Ezen a linken találtam egy igen hatásos megoldást VBA-ban (angolul):
https://www.mrexcel.com/forum/excel-questions/959222-vba-copy-formatting-without-copying-rules-conditional-formatted-cell.html
Ezzel nem azt akarom mondani, hogy a feltételes formázás nem hasznos. Aki tudja mit csinál és makrómentes megoldást akar annak remek választás.
Mindenesetre én továbbfejlesztettem a kódomat, így az új változatban:
– nem kell módosítani a makrót, ha új sorokat adunk hozzá a tartományhoz
– hozzáadtam a kódot a mentés eseménykezelőhöz, így ha mentjük a fájlt, akkor a színezés megtörténik
Újragondolt változat:
Az adott munkafüzetbe szúrjunk be egy modult a Visual Basic szerkesztőjében és az alábbi kódot adjuk hozzá:
|
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 |
Sub ScoreCard_Szinez_02() Dim Mit As Range, Cel As Range, i As Long, j As Long, Rng As Range, BalFelso As Range, Z As Long 'készítette: XLMotyo 'ha új sort adunk a tartományhoz, a makró az új tartománnyal fog dolgozni, nem kell a kódot módosítani Application.ScreenUpdating = False Set Rng = Sheet1.UsedRange 'adatartomány elsõ (bal felsõ) cellája: For i = 1 To Rng.Rows.Count For j = 1 To Rng.Columns.Count If Rng.Cells(i, j).Value = "KPI" Then Set BalFelso = Rng.Cells(i + 1, j + 3) 'itt: "e3"-as tartomány GoTo Kovetkezo End If Next j Next i Kovetkezo: 'adattartomány megadása: Set Mit = Sheet1.Range(Cells(BalFelso.Row, BalFelso.Column).Address, _ Cells(Rng.Rows.Count, Rng.Columns.Count).Address) 'itt: "e3:g6"-os tartomány 'céltartomány megadása: Set Cel = Mit.Columns(0) 'itt: "d3:d6"-os tartomány Mit.Font.ColorIndex = xlAutomatic Z = Mit.Columns.Count + 1 'használt tartomány utolsó oszlopa, mely tartalmazza pl. a ">=" jelet 'adattartomány celláinak színezése a büdzsé alapján: For i = 1 To Mit.Rows.Count For j = 1 To Mit.Columns.Count If Mit.Cells(i, Z).Value = ">=" Then 'nagyobb érték a jobb If Mit.Cells(i, j).Value >= Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = RGB(0, 176, 80) ElseIf Mit.Cells(i, j).Value < Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = vbRed End If ElseIf Mit.Cells(i, Z).Value = "<=" Then 'kisebb érték a jobb If Mit.Cells(i, j).Value <= Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = RGB(0, 176, 80) ElseIf Mit.Cells(i, j).Value > Cel.Cells(i, 1).Value Then Mit.Cells(i, j).Font.Color = vbRed End If End If Next j Next i Application.ScreenUpdating = True End Sub |
A VBA szerkesztőjében a “ThisWorkbook”-hoz pedig az alábbi kódot adjuk hozzá (ez futtatja le a makrót mentéskor):
|
1 2 3 |
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Call ScoreCard_Szinez_02 End Sub |
Vagyis a kód hozzáadása után hozzáadhatunk új sorokat és elég mentenünk a fájlt a színezéshez:
Remélem hasznos volt a poszt.
Mintafájlért illetve kérdésekkel kapcsolatosan szólj hozzá lent vagy dobj egy emailt: xlmotyo@gmail.com
