Adott fájlokban lévő munkalapok adatainak összesítése egy összesítő munkafüzet adott lapjára.
Számos alkalommal a gyárak vagy országok kitöltötték a hozzájuk tartozó input fájlt (esetleg feltöltötték a céges weboldalra SharePoint-ban) én pedig ezeket összesítettem. Az elején a legnehezebb a forrásadatok egységességének biztosítása volt, vagyis hogy mindenki az elküldött sablont használja, ne változtasson a munkalap struktúráján stb.
Jelen esetben adott három input munkafüzet (Forras01, Forras02 és Forras03) és az ezekben lévő “Sheet1” nevű munkalapokról kell összesítenünk az adatokat egy új munkafüzet (Osszesito) adott lapjára:
Ezt az összesítést végezhetjük el másodpercek alatt (nálam konkréten két másodperc alatt futott le a lenti makró). 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 |
Sub AdatOsszesitesEgyFajlba() Dim FileLocation As String, FileName As String, Sh As Worksheet, X As Long, Z As Long Application.ScreenUpdating = False 'Készítette: XLMotyo (https://xlmotyo.hu/) 'kimásolja az adatokat a forrásfájlokból és összesíti egy új fájlban 'a forrásfájlok és az összesítõ fájl közös mappában vannak. Ezt a kódot az összesítõ fájlhoz hozzáadjuk majd lefuttatjuk 'cellatartalom törlése a "Summary" munkalapon ThisWorkbook.Worksheets("Summary").Cells.Clear 'munkalap nevét frissíteni ha szükséges 'fájlok helyének és neveinek meghatározása FileLocation = ThisWorkbook.Path & "\" 'frissíteni ha szükséges FileName = Dir(FileLocation & "*xls??") X = 5 'Ennél a sornál kezdõdik a tartomány az input fájlokban. Frissíteni ha szükséges Do While FileName <> "" 'végigmegyünk az összes fájlon abban a mappában, ahol az input fájlok találhatók If FileName <> ThisWorkbook.Name Then Workbooks.Open (FileLocation & FileName) 'forrás fájl megnyitása For Each Sh In ActiveWorkbook.Worksheets 'ha a fájlt megnyitjuk, az lesz az aktív munkafüzet (ActiveWorkbook) If Sh.Name = "Sheet1" Then '"Sheet1" munkalapról adatok összegyûjtése. Frissíteni ha szükséges Z = Sh.UsedRange.Rows.Count 'hány sorból áll a használt tartomány (UsedRange) a forrásfájlban 'nem másolunk, itt a két tartomány értékeit tesszük egyenlõvé az összesítõ fájl és a forrásfájlok közt 'a forrásfájloknál az adattartomány itt a B5-ös cellában kezdõdik = cells(5,2) Sheet1.Range(Cells(X, 2).Address, Cells(X + Z - 1, 7).Address) = _ Sh.Range(Cells(5, 2).Address, Cells(5 + Z - 1, 7).Address).Value X = X + Z Exit For 'ha a "Sheet1" lapot megtaláltuk: lépjen ki a ciklusból End If Next Sh Workbooks(FileName).Close End If FileName = Dir() 'üres szöveges változó megadása azért, hogy a mappában lévõ minden fájlon menjen végig a makró Loop Application.ScreenUpdating = True End Sub |
Videó, melyben a makró működését szemléltetem, magyarázatokkal:
Az összesítésnél nem másolást illetve értékbeillesztést használtam, hanem két tartomány értékeit tettem egyenlővé – lásd fenti videót 2:17-től (direkt link: https://youtu.be/LHHMCMA7q4Q?t=137).
Ötletek a fenti kód továbbfejlesztésére:
- input (vagyis forrás) fájlok másik mappában vannak
- felhasználó jelölje ki az input fájlokat tartalmazó mappát
- forrásfájloknál egynél több munkalapról kell összesíteni az adatokat
- értéken felül jelenjen meg a formázás illetve a formulák az összesítőben
- … és ami még eszetekbe jut
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
