Adódik olyan szituáció, mikor két tartományt kell összehasonlítanunk (cellánként) és a különbségeket akarjuk kiemelni, például színezéssel.
Egyszerű probléma, ugyanakkor felmerül néhány kérdés:
– a két tartomány egy munkalapon van, esetleg különböző munkalapokon?
– mi van akkor ha a tartomány munkalapjai külön munkafüzetben vannak?
– kijelölhetjük mi a tartományt?
– vizsgáljuk, hogy a két tartomány ugyanannyi cellát tartalmaz-e?
– képleteket vagy értékeket szeretnénk összehasonlítani? Esetleg mindkettőt?
– mi a helyzet, ha a tartomány cellái már eleve színezettek? Az eltérések színezése nem teszi tönkre a meglévő színkódolást?
– eltérő cellák színét lehet később változtatni?
Mindezen kívánalmaknak megfelel az általam készített megoldás, mely így néz ki animált verzióban:
A fenti példánál tehát a tartományok külön munkalapon helyezkednek el.
A makróban megjegyzésként hozzáadtam a megértést segítő magyarázatokat. 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 55 56 57 58 59 60 61 62 63 64 |
Sub KetTartomanyOsszehasonlitasa() Dim Tart1 As Range, Tart2 As Range, i As Long, Valasz As Long 'Készítette: XLMotyo (https://xlmotyo.hu) 'összehasonlítja a két kijelölt tartományban a képleteket és/vagy az értékeket, majd a különbségeket sárga színnel jelöli 'felhasználó jelölje ki a két tartományt. A tartományok lehetnek közös vagy különbözõ munkalapon: On Error GoTo Vege Set Tart1 = Application.InputBox("Jelöld ki az összehasonlítás alapját adó elsõ tartományt", "Elsõ tartomány", , , , , , 8) Set Tart2 = Application.InputBox("Jelöld ki a második tartományt!", "Második tartomány", , , , , , 8) Application.ScreenUpdating = False 'ellenõrzés, hogy a két kijelölt tartomány ugyanannyi cellát tartalmaz-e If Tart1.Cells.Count <> Tart2.Cells.Count Then MsgBox "A két tartomány nem ugyanannyi cellát tartalmaz!", vbExclamation, "" Exit Sub End If 'a tartományok celláinak színét alapra állítani ha szükséges If MsgBox("Szeretnéd a cellák színét alapra állítani a kijelölt tartományokban?", vbYesNo, "") = vbYes Then Application.ScreenUpdating = True Tart1.Interior.Pattern = xlNone Tart2.Interior.Pattern = xlNone End If Application.ScreenUpdating = False 'különbségek színezése mindkét tartományban: Valasz = MsgBox("Mit szeretnél összehasonlítani" & vbNewLine & _ "Yes:" & vbTab & "Képleteket" & vbNewLine & _ "No:" & vbTab & "Értékeket" & vbNewLine & _ "Cancel:" & vbTab & "Képleteket + Értékeket", vbYesNoCancel, "") If Valasz = vbYes Then 'képletek For i = 1 To Tart1.Cells.Count If CStr(Tart1.Cells(i).Formula) <> CStr(Tart2.Cells(i).Formula) Then Tart1.Cells(i).Interior.Color = vbYellow Tart2.Cells(i).Interior.Color = vbYellow End If Next i ElseIf Valasz = vbNo Then 'értékek For i = 1 To Tart1.Cells.Count If CStr(Tart1.Cells(i).Value) <> CStr(Tart2.Cells(i).Value) Then Tart1.Cells(i).Interior.Color = vbYellow Tart2.Cells(i).Interior.Color = vbYellow End If Next i ElseIf Valasz = vbCancel Then 'képletek + értékek For i = 1 To Tart1.Cells.Count If CStr(Tart1.Cells(i).Formula) <> CStr(Tart2.Cells(i).Formula) Or _ CStr(Tart1.Cells(i).Value) <> CStr(Tart2.Cells(i).Value) Then Tart1.Cells(i).Interior.Color = vbYellow Tart2.Cells(i).Interior.Color = vbYellow End If Next i End If Application.ScreenUpdating = True Vege: End Sub |
Ehelyett a megoldás helyett…
… kreálhattam volna egy űrlapot “Képletek”, “Értékek” valamint “Képletek + Értékek” gombbal de ez frappánsabbnak tűnt és a kód is gyorsabban lefut. Úgy is felvezethettem volna ezt, hogy “Képzeljétek, micsoda felfedezés: a MsgBox-nál a ‘Cancel’ (‘Mégse’) gombhoz is lehet makrót hozzárendelni!” 🙂
A makró lefutása után kapott eredmény (képletek + értékek összehasonlításánál):
