Hát ismét eljött az év utolsó hónapja és vele együtt az idei utolsó poszt. Azt nem mondhatnám, hogy elröppent ez az esztendő, én legalábbis nem így éreztem.
Az egyedi értékeket többféleképpen is ki lehet gyűjteni egy adott tartományból, erről már írtam egy hosszabb bejegyzést, ami itt olvasható.
De mi a helyzet akkor, ha pl. az „A” oszlopból meg akarjuk kapni az egyedi adatokat, mellette pedig a „B” oszlopból az összes hozzá tartozó adatot egyetlen cellában. Vagyis
ebből
akarjuk megkapni ezt:
Persze a forrástartomány módosítása esetén frissüljön az eredmény, lehetőleg egy-két kattintással.
Két megoldást ismertetek a fenti problematikára:
I. Power Query-vel (PQ)
Aki már ismeri a PQ-t, az átugorhatja a magyarázat részt és folytathatja a “PQ lépések” résszel ide kattintva.
Ez az Excel része a 2016-os verziótól.
2010-es (kizárólag 2010 Professional Plus!) és 2013-as verzióban is használható, ehhez egy ingyenes bővítményt kell letölteni és feltenni.
Infóként: cikk a bővítmény letöltéséhez, a verziók megállapításához (hogy 32 vagy 64 bit-es az Excelünk) és egyéb kiegészítő tartalom (angolul):
https://engineerexcel.com/installing-power-query-add-in/
Az ingyenes Power Query bővítmény letöltése 2010 Professional Plus és 2013-as verziókhoz:
https://www.microsoft.com/hu-HU/download/details.aspx?id=39379
Print screen az utóbbi linkhez:
Ezek után a letöltött .msi fájlt futtassuk és telepítsük:
PQ bővítmény hozzáadása:
Fájl -> Beállítások -> Bővítmények -> COM bővítmények -> Ugrás
Majd Power Query bővítmény kiválasztása -> OK
Ebben a két verzióban (2010 és 2013) külön Power Query menüt fogsz látni, 2016-os verziótól pedig az Adatok menüben az „Adatok beolvasása és átalakítása” szekcióban található a PQ – pl. nálam Office 365-ben:
_
PQ lépések:
1. A tartomány táblázattá alakítása:
Aktív cella a tartományon belül legyen:
Beszúrás menü -> Táblázat -> OK
2. Táblázat beolvasása PQ-be:
Aktív cella a táblázaton belül van -> Adatok menü -> Adatok beolvasása -> Más forrásokból -> Táblázatból vagy tartományból
Ezt követően megnyílik a PQ szerkesztő ablaka.
3. kiválasztani a „KPI” oszlopot (elvileg már ki is van) -> jobb klikk a KPI oszlop fejlécén -> Csoportosítási szempont (angolul ez kifejezőbb: „Group By”)
4. „KPI” kiválasztása
Új oszlopnév: itt „AllData”
Művelet: Minden sor
OK
Megjegyzés: ha az „Email” oszlopban számok lennének és azt szeretnénk összesíteni KPI-ok alapján, akkor a 4. pont az alábbiak szerint módosul (Sárga színnel kiemeltem az eltérést az előző képhez viszonyítva):
Ekkor innen indulnánk:
És ide jutnánk:
Ez esetben figyelmen kívül kell hagynunk az 5-8. lépéseket
5. Oszlop hozzáadása menü -> Egyéni oszlop:
Új oszlopnév: itt „Custom”
Egyéni oszlopképlet: [AllData][Email] – az „=” jel már eleve ott van
OK
Jelenleg így néz ki a PQ szerkesztőnk:
6. „Custom” oszlop: a fejlécben kattintsunk rá az ellentétes nyilakra -> Értékek kinyerése
7. Elválasztó karakter: itt „Pontosvessző” -> OK:
Kezd biztató lenni az eredmény a „Custom” oszlopnál:
8. Ezután törölhetjük is az „AllData” oszlopot: jobb klikk a fejlécén -> Eltávolítás
9. Töltsük be az eredményt Excel-be:
PQ szerkesztőben: Kezdőlap menü -> Bezárás és betöltés
Visszatérünk Excelbe és egy új munkalapon máris ott van a kivonat, táblázat formájában:
Innentől fogva ha a forrás munkalapon változik a forrás táblázatunk, akkor elegendő visszatérni a másik munkalapra az eredmény táblázathoz, majd:
Jobb klikk a táblázaton belül -> Frissítés
II. VBA-val
A forrás tartomány itt is ugyanaz. A makró lefuttatása után az eredményt a “D:E” oszlopokban láthatjuk:
Kód, amit az adott munkafüzet új moduljához kell hozzáadni:
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 |
Sub AdatokCsoportositasa() Dim D As Object, i As Long, Rng As Range, X, j As Long, Szoveg As String, Adat() 'Készítette: XLMotyo (https://xlmotyo.hu) 'egyesíti az értékeket a "B" oszlopban az "A" oszlopban lévõ duplikációk alapján, vagyis: 'ebbõl: 'KPI10 valami100@fff.com 'KPI10 valami200@fff.com 'ez lesz: 'KPI10 valami100@fff.com;valami200@fff.com Set D = CreateObject("scripting.dictionary") Set Rng = Sheet1.UsedRange 'frissíteni ha kell Rng.Columns("D:E").Clear 'frissíteni ha kell For i = 2 To Rng.Rows.Count D(CStr(Rng.Cells(i, 1))) = "" Next i X = D.keys For i = 0 To D.Count - 1 Szoveg = "" For j = 2 To Rng.Rows.Count If X(i) = Rng.Cells(j, 1) Then Szoveg = Szoveg & ";" & Rng.Cells(j, 2) If Left(Szoveg, 1) = ";" Then Szoveg = Right(Szoveg, Len(Szoveg) - 1) End If Next j ReDim Preserve Adat(i) Adat(i) = X(i) & ":" & Szoveg Next i For i = LBound(Adat) To UBound(Adat) 'Sheet1.Cells(i + 1, 4) = Adat(i) Sheet1.Cells(i + 1, 4) = Split(Adat(i), ":")(LBound(Split(Adat(i), ":"))) 'pl.: KPI10 Sheet1.Cells(i + 1, 5) = Split(Adat(i), ":")(UBound(Split(Adat(i), ":"))) 'pl.: valami100@fff.com;valami200@fff.com Next i End Sub |
Ha módosul a forrás, akkor újból futtassuk le a makrót és frissül a kimeneti rész (“D:E” oszlopok).
Mindenkinek kitartást, jó egészséget! Bízzunk benne, hogy 2021 örömtelibb, kiszámíthatóbb és gyümölcsözőbb lesz.
S persze Boldog(abb) Új Esztendőt Kívánok!