Korábban már néztünk lehetőségeket arra, hogy két adattábla egyezőségét vizsgáljuk Excelben (Excel - Két adattábla tartalmának összevetése). Ellenőriztük, van-e strukturális különbség (eltérés a sorok, oszlopok számában, sor- és oszlopazonosítókban), valamint tartalmi különbség (eltérő értékek). Ehhez függvényeket és az Excel kínálta megoldásokat használtunk. Amit akkor nem sikerült megvalósítani, hogy legyen egy listánk az eltérésekről. Most ugyanezeket az összehasonlításokat végezzük el Excel makró segítségével, végeredményként pedig előállítjuk a tartalmi eltérések listáját egy új munkalapon.
Ha még bizonytalanul mozogsz a makrók nyelvezetében, javaslom, fusd át az Excel makró - Alapfogalmak című cikkünket!
Első lépésben létrehozzuk a makró keretét, nevet adunk neki (pl. CompareTwoTables) és egy rövid leírást, hogy mit is csinál, mire kell figyelni a használatakor.
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
'Tartalmi különbségek'
End SubEzután jöhetnek az egyes ellenőrzések. Az összes ellenőrzés során a két munkalapot (OLD és NEW) hasonlítjuk össze, csak más és más tulajdonságaikat. A strukturális különbségek vizsgálatánál bármilyen eltérés esetén szeretnénk megszakítani a további vizsgálatot, hiszen ha eltér a sorok vagy oszlopok száma, mások az oszlop- és/vagy a sorazonosítók, akkor a tartalmi összevetést vizsgálni nem is biztos, hogy érdemes. A sorok számának vizsgálatához a munkalapok UsedRange tulajdonságából a Rows paramétert számoltatjuk össze a Count opcióval. A sorok számát kiolvassuk egy-egy változóba, majd ezek értékeit vetjük össze egy logikai vizsgálatban (If...Then...Else...End If). Ha eltér a két érték, egy üzenetablakot (MsgBox) helyezünk el a felhasználó számára, majd ha megnyomta az OK gombot, kilépünk a makróból (Exit Sub).
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
old_rows_count = Worksheets("OLD").UsedRange.Rows.Count
new_rows_count = Worksheets("NEW").UsedRange.Rows.Count
If old_rows_count <> new_rows_count Then
MsgBox ("A sorok száma eltér a két munkalapon! OLD: " & old_rows_count & ", NEW: " & new_rows_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
'Tartalmi különbségek'
End SubÍgy fog kinézni az üzenet, ha eltér a sorok száma a két táblában:
A sorokhoz hasonló módon az oszlopok számát is összehasonlítjuk. Az első különbség, hogy a UsedRange-ből most a Column tulajdonságot számoltatjuk össze, valamint más nevű változókban tároljuk el a két munkalap oszlopainak számát. Az összehasonlítás logikája ugyanaz és az oszlopok számának eltérése esetén a teendők is ugyanazok: üzenet a felhasználónak, majd kilépés.
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
old_rows_count = Worksheets("OLD").UsedRange.Rows.Count
new_rows_count = Worksheets("NEW").UsedRange.Rows.Count
If old_rows_count <> new_rows_count Then
MsgBox ("A sorok száma eltér a két munkalapon! OLD: " & old_rows_count & ", NEW: " & new_rows_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
old_cols_count = Worksheets("OLD").UsedRange.Columns.Count
new_cols_count = Worksheets("NEW").UsedRange.Columns.Count
If old_cols_count <> new_cols_count Then
MsgBox ("Az oszlopok száma eltér a két munkalapon! OLD: " & old_cols_count & ", NEW: " & new_cols_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
'Tartalmi különbségek'
End SubÍgy fog kinézni az üzenet, ha eltér az oszlopok száma a két táblában:
A fejléc értékeinek vizsgálatához mindkét munkalap első során kell végighaladnunk oszlopról oszlopra és a cellákban található értékeket kell összevetnünk. Ehhez egy For iterációt fogunk használni, ahol az elsőtől (c = 1) az utolsó oszlopig (old_cols_count) haladunk szépen sorban. Az éppen vizsgált cellát a Cells(sor, oszlop) segítségével határozzuk meg és a benne lévő értéket a Value használatával tudjuk kiolvasni. Az összehasonlításhoz ezúttal is az If...Then...End If szerkezetet használjuk, ha eltérést találunk ugyanúgy üzenetet küldünk (persze eltérő tartalommal) a felhasználónak, majd kilépünk a makróból.
Miért pont az old_cols_count értékét használtam és miért nem a new_cols_count-ot? Valójában mindegy, melyiket használod a kettő közül, hiszen a makró nem jut el eddig a pontig, ha a két munkalapon nem azonos az oszlopok száma!
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
old_rows_count = Worksheets("OLD").UsedRange.Rows.Count
new_rows_count = Worksheets("NEW").UsedRange.Rows.Count
If old_rows_count <> new_rows_count Then
MsgBox ("A sorok száma eltér a két munkalapon! OLD: " & old_rows_count & ", NEW: " & new_rows_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
old_cols_count = Worksheets("OLD").UsedRange.Columns.Count
new_cols_count = Worksheets("NEW").UsedRange.Columns.Count
If old_cols_count <> new_cols_count Then
MsgBox ("Az oszlopok száma eltér a két munkalapon! OLD: " & old_cols_count & ", NEW: " & new_cols_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
For c = 1 To old_cols_count
If Worksheets("OLD").Cells(1, c).Value <> Worksheets("NEW").Cells(1, c).Value Then
MsgBox ("A fejléc eltér a " & c & ". oszlopban! OLD: " & Worksheets("OLD").Cells(1, c).Value & ", NEW: " & Worksheets("NEW").Cells(1, c).Value)
Exit Sub
End If
Next c
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
'Tartalmi különbségek'
End SubÍgy fog kinézni az üzenet, ha eltér a fejléc a két táblában:
A sorazonosítók ellenőrzésének logikája is nagyon hasonló, csak oszlopok helyett sorokon haladunk végig. A For ciklussal ezúttal az első sortól (r = 1) haladunk az utolsó sorig (old_rows_count), kiolvassuk mindkét munkalapon az első oszlop értékét az adott sorban és összehasonlítjuk a két értéket. Ha eltérést tapasztalunk, üzenetet küldünk a fehasználónak és kilépünk a makróból.
Igen, itt is mindegy, hogy az old_rows_count vagy a new_rows_count szerepel a ciklus végpontjaként, hiszen ha a kettő nem egyezne meg, a makró futása már megszakadt volna.
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
old_rows_count = Worksheets("OLD").UsedRange.Rows.Count
new_rows_count = Worksheets("NEW").UsedRange.Rows.Count
If old_rows_count <> new_rows_count Then
MsgBox ("A sorok száma eltér a két munkalapon! OLD: " & old_rows_count & ", NEW: " & new_rows_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
old_cols_count = Worksheets("OLD").UsedRange.Columns.Count
new_cols_count = Worksheets("NEW").UsedRange.Columns.Count
If old_cols_count <> new_cols_count Then
MsgBox ("Az oszlopok száma eltér a két munkalapon! OLD: " & old_cols_count & ", NEW: " & new_cols_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
For c = 1 To old_cols_count
If Worksheets("OLD").Cells(1, c).Value <> Worksheets("NEW").Cells(1, c).Value Then
MsgBox ("A fejléc eltér a " & c & ". oszlopban! OLD: " & Worksheets("OLD").Cells(1, c).Value & ", NEW: " & Worksheets("NEW").Cells(1, c).Value)
Exit Sub
End If
Next c
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
For r = 1 To old_rows_count
If Worksheets("OLD").Cells(r, 1).Value <> Worksheets("NEW").Cells(r, 1).Value Then
MsgBox ("A sorazonosító eltér a " & r & ". sorban! OLD: " & Worksheets("OLD").Cells(r, 1).Value & ", NEW: " & Worksheets("NEW").Cells(r, 1).Value)
Exit Sub
End If
Next r
'Tartalmi különbségek'
End SubÍgy fog kinézni az üzenet, ha eltér a sorazonosító a két táblában:
A makró ebben a formájában csak az egy soros fejlécet képes ellenőrizni, a többi sort már adatként kezeli. Hasonlóképpen az első oszlopról feltételezi, hogy a sorazonosítókat tartalmazza. Ha táblák struktúrája ezektől eltérő (pl. többsoros fejléce van a táblának vagy a sorazonosítók másik oszlopban találhatók vagy több oszlop között oszlanak szét), akkor a makrón módosítani kell!
A strukturális hibák ellenőrzésével végeztünk, ezen a ponton biztosak lehetünk benne, hogy a két tábla szerkezete megegyezik. Következhet tehát a tartalmi ellenőrzés. Ennek során sorról sorra, azon belül oszlopról oszlopra haladva minden cella tartalmát összevetjük a másik munkalap azonos pozíciójában (sorában, oszlopában) található cella tartalmával. Ezúttal azonban másképpen járunk el, ha eltérést tapasztalunk.
Nem akasztjuk meg a makró futását minden tartalmi különbség esetén, hiszen lehet, hogy ezekből több száz is található, ha a tábla nagyon nagy. Ezért inkább létrehozunk egy új munkalapot (a neve legyen DIFF), amelyen rögzítjük melyik sorban (ROW oszlop), melyik oszlopban (COL oszlop) található az eltérés és mi a régi érték (OLD_VALUE oszlop) és mi az új érték (NEW_VALUE oszlop).
Mindehhez először is bevezetünk egy változót (differences), amely segítségével tudjuk számolni az eltéréseket. Ennek a változónak a kezdeti értéke ezért 0. Következő lépésben az Add() segítségével létrehozzuk az új munkalapot, a Name segítségével pedig elnevezzük. Utána az első sor első négy oszlopába beírjuk a korábban kitalált fejlécet.
Ezután már megírhatjuk a két egymásba ágyazott For ciklust. A külső a második sortól (r = 2) az utolsóig (old_rows_count), a belső az aktuális soron a második oszloptól (c = 2) az utolsóig (old_cols_count) halad végig. A ciklus belsejében elhelyezzük a logikai vizsgálatot, amely összeveti az adott sor, adott oszlopának értékét a régi és az új munkalapon. Eltérés esetén a DIFF munkalap következő sorát (ez mindig a differences aktuális értéke + 2, így az elején, amikor a differences = 0, a második sort) kitölti a sor azonosítóval (r), oszlop azonosítóval (c) és a két értékkel, amit a cellákból kiolvasott. Végül megnöveljük a differences értékét eggyel, hiszen találtunk egy eltérést.
Miért a második sortól és oszloptól? Azért mert éltünk azzal a feltételezéssel, hogy az első sorban a fejléc, az első oszlopban pedig a sorazonosító található, és ezek egyezőségét már vizsgáltuk! Ezért itt felesleges lenne ismételten ellenőrizni az értéküket.
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
old_rows_count = Worksheets("OLD").UsedRange.Rows.Count
new_rows_count = Worksheets("NEW").UsedRange.Rows.Count
If old_rows_count <> new_rows_count Then
MsgBox ("A sorok száma eltér a két munkalapon! OLD: " & old_rows_count & ", NEW: " & new_rows_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
old_cols_count = Worksheets("OLD").UsedRange.Columns.Count
new_cols_count = Worksheets("NEW").UsedRange.Columns.Count
If old_cols_count <> new_cols_count Then
MsgBox ("Az oszlopok száma eltér a két munkalapon! OLD: " & old_cols_count & ", NEW: " & new_cols_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
For c = 1 To old_cols_count
If Worksheets("OLD").Cells(1, c).Value <> Worksheets("NEW").Cells(1, c).Value Then
MsgBox ("A fejléc eltér a " & c & ". oszlopban! OLD: " & Worksheets("OLD").Cells(1, c).Value & ", NEW: " & Worksheets("NEW").Cells(1, c).Value)
Exit Sub
End If
Next c
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
For r = 1 To old_rows_count
If Worksheets("OLD").Cells(r, 1).Value <> Worksheets("NEW").Cells(r, 1).Value Then
MsgBox ("A sorazonosító eltér a " & r & ". sorban! OLD: " & Worksheets("OLD").Cells(r, 1).Value & ", NEW: " & Worksheets("NEW").Cells(r, 1).Value)
Exit Sub
End If
Next r
'Tartalmi különbségek'
differences = 0
Worksheets.Add().Name = "DIFF"
Worksheets("DIFF").Cells(1,1).Value = "ROW"
Worksheets("DIFF").Cells(1,2).Value = "COL"
Worksheets("DIFF").Cells(1,3).Value = "OLD_VALUE"
Worksheets("DIFF").Cells(1,4).Value = "NEW_VALUE"
For r = 2 To old_rows_count
For c = 2 To old_cols_count
If Worksheets("OLD").Cells(r,c).Value <> Worksheets("NEW").Cells(r,c).Value Then
Worksheets("DIFF").Cells(differences + 2,1).Value = r
Worksheets("DIFF").Cells(differences + 2,2).Value = c
Worksheets("DIFF").Cells(differences + 2,3).Value = Worksheets("OLD").Cells(r,c).Value
Worksheets("DIFF").Cells(differences + 2,4).Value = Worksheets("NEW").Cells(r,c).Value
differences = differences + 1
End If
Next c
Next r
End SubValójában már kész is lennénk, ami hátra van, csak egy kis szépítése az ellenőrzésnek. Először is ellenőrizzük, hogy a differences értéke nagyobb-e mint 0, miután az iteráció véget ért. Ha nem, vagyis nem volt eltérés, a DIFF munkalapra semmi szükség, ezért a Delete segítségével kitöröljük. Sajnos ez a művelet alapértelmezetten felhasználói megerősítést kérne, mi azonban biztosan tudjuk, hogy törölhető, a törlés előtt az Application.DisplayAlerts értékét hamisra állítjuk, hogy ne kérjen megerősítést a felugró ablakban, töröljük a munkalapot, majd a Application.DisplayAlerts értékét visszaállítjuk igazra, hogy a program megszokott működését biztosíthassuk. Ezen túl pedig megjelenítünk egy üzenetet, amelyben tájékoztatjuk a felhasználót, hogy tartalmi különbséget sem találtunk.
Így fog kinézni az üzenet, ha minden azonos a két táblában:
Ha a differences értéke eltér a 0-tól, megjelenítünk egy üzenetet, amelyben arról tájékoztatjuk a felhasználót, hogy hány darab eltérést találtunk és hogy ezeket a DIFF munkalapon tekintheti meg.
Így fog kinézni az üzenet és a DIFF munkalap, ha van tartalmi különbség a két táblában:
Sub CompareTwoTables()
'A makró célja, hogy két adattábla tartalmát összehasonlítsa, esetleges eltéréseiket jelezze és ezekről listát készítsen.'
'A makró igényel némi előkészítést.'
'A két adattábla adatait egy munkafüzet egy-egy munkalapjára kell másolni, a régebbit "OLD", az újabbat "NEW" névvel kell'
'ellátni (idézőjelek nélkül).'
'Strukturális különbségek'
'Ellenőrizzük, a két munkalapon azonos számú sor szerepel-e'
old_rows_count = Worksheets("OLD").UsedRange.Rows.Count
new_rows_count = Worksheets("NEW").UsedRange.Rows.Count
If old_rows_count <> new_rows_count Then
MsgBox ("A sorok száma eltér a két munkalapon! OLD: " & old_rows_count & ", NEW: " & new_rows_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon azonos számú oszlop szerepel-e'
old_cols_count = Worksheets("OLD").UsedRange.Columns.Count
new_cols_count = Worksheets("NEW").UsedRange.Columns.Count
If old_cols_count <> new_cols_count Then
MsgBox ("Az oszlopok száma eltér a két munkalapon! OLD: " & old_cols_count & ", NEW: " & new_cols_count)
Exit Sub
End If
'Ellenőrizzük, a két munkalapon megegyezik-e a fejléc (az első sor értékei, a sorrendet is figyelembe véve)'
For c = 1 To old_cols_count
If Worksheets("OLD").Cells(1, c).Value <> Worksheets("NEW").Cells(1, c).Value Then
MsgBox ("A fejléc eltér a " & c & ". oszlopban! OLD: " & Worksheets("OLD").Cells(1, c).Value & ", NEW: " & Worksheets("NEW").Cells(1, c).Value)
Exit Sub
End If
Next c
'Ellenőrizzük, a két munkalapon megegyeznek-e a sor azonosítók (az első oszlop értékei, a sorrendet is figyelembe véve)'
For r = 1 To old_rows_count
If Worksheets("OLD").Cells(r, 1).Value <> Worksheets("NEW").Cells(r, 1).Value Then
MsgBox ("A sorazonosító eltér a " & r & ". sorban! OLD: " & Worksheets("OLD").Cells(r, 1).Value & ", NEW: " & Worksheets("NEW").Cells(r, 1).Value)
Exit Sub
End If
Next r
'Tartalmi különbségek'
differences = 0
Worksheets.Add().Name = "DIFF"
Worksheets("DIFF").Cells(1,1).Value = "ROW"
Worksheets("DIFF").Cells(1,2).Value = "COL"
Worksheets("DIFF").Cells(1,3).Value = "OLD_VALUE"
Worksheets("DIFF").Cells(1,4).Value = "NEW_VALUE"
For r = 2 To old_rows_count
For c = 2 To old_cols_count
If Worksheets("OLD").Cells(r,c).Value <> Worksheets("NEW").Cells(r,c).Value Then
Worksheets("DIFF").Cells(differences + 2,1).Value = r
Worksheets("DIFF").Cells(differences + 2,2).Value = c
Worksheets("DIFF").Cells(differences + 2,3).Value = Worksheets("OLD").Cells(r,c).Value
Worksheets("DIFF").Cells(differences + 2,4).Value = Worksheets("NEW").Cells(r,c).Value
differences = differences + 1
End If
Next c
Next r
If differences = 0 Then
Application.DisplayAlerts = False
Worksheets("DIFF").Delete
Application.DisplayAlerts = True
MsgBox ("A két adattábla teljesen megegyezik!")
Else
MsgBox ("A két adattábla strukturálisan megegyezik, tartalmi különbségeik (" & differences & " darab) a DIFF munkalapon láthatók!")
End If
End SubÍgy már tényleg készen vagyunk, a makró működik!
Előfordulhat, hogy az eltérés sorának és oszlopának sorszáma helyett hasznosabb a sor- vagy oszlop azonosító kiírása a DIFF munkalapra. Ez is megoldható, ha így szeretnél tenni, akkor ezt a két sort:
Worksheets("DIFF").Cells(differences + 2,1).Value = r
Worksheets("DIFF").Cells(differences + 2,2).Value = c
cseréld erre:
Worksheets("DIFF").Cells(differences + 2,1).Value = Worksheets("OLD").Cells(r,1).Value
Worksheets("DIFF").Cells(differences + 2,2).Value = Worksheets("OLD").Cells(1,c).Value
Használjátok sok sikerrel és nyúljatok hozzá bátran a kódhoz, módosítgassátok, próbálkozzatok, így egyre jobban fogjátok érteni az Excel makrók működését!