Adatok összefűzése egy fülre

Ebben a cikkben egy olyan kódot mutatok be, ami több fülről fűzi össze az adatokat egy összesítő fülre.

Ennek a feladatnak az inverze, azaz egy fülről történő szétválogatás, itt olvasható.

A kezdeti állapotban négy kitöltött fülünk van, mindegyiken egy-egy autómárka autói. Ezeket szeretnénk összefűzni az Összes fülre.

Hozzunk létre egy új modult, benne pedig egy Osszefuzes nevű subroutine-t.

Mielőtt belekezdünk, gondoljuk végig a feladat menetét!

A kódunknak minden forrás fülön meg kell találnia a másolandó tartományt, ami a másodiktól az utolsó sorig tart (a fejlécet nem akarjuk másolni, feltételezzük, hogy ez már ott van az Összesítő fülön). Ezt a tartomány másoljuk az Összesítő fül aktuális utolsó sora utáni sorba.

Tároljuk el az összesítő fül nevét egy változóban.

[code language=”vb”]Set shtAll= Sheets("Összesitö")[/code]

(Érdemes kerülni az Ő és Ű betűk használatát, ezért szándékosan Összesitönek neveztem el a fület.)

Töröljük az Összesítő fül tartalmát. (A Rows.Count a munkalapon található sorok számára vonatkozik, ami xlsx kiterjesztés esetén 1.048.576)

[code language=”vb”]For Each sht In ThisWorkbook.Sheets

Next sht[/code]

Mivel az összesítő fülről nem másolunk, így a ciklusba bekerül egy elágazás, ami megvizsgálja, hogy a sht objektumban tárolt azonos-e a shtAllobjektummal, és csak abban az esetben lépünk a ciklusba, ha ez hamis. (Objektumok összehasonlításánál az is kulcsszót használjuk.)

[code language=”vb”]For Each sht In ThisWorkbook.Sheets

If Not sht Is shtAll Then

End If

Next sht[/code]

Az elágazásba belépve keressük meg a forrásfül (Ford, Renault, Opel vagy Kia) utolsó sorát.

[code language=”vb”]lastRowSource= sht.Range("A1").CurrentRegion.Rows.Count[/code]

Keressük meg az Összesítő fül utolsó sorát is.

[code language=”vb”]lastRowAll= shtAll.Range("A1").CurrentRegion.Rows.Count[/code]

Határozzuk meg a másolandó tartományt. Ez az adott márka fül második sorától az előbb megállapított lastRowSource-ig, A oszloptól E oszlopig tart.

[code language=”vb”]Set rngCopy = sht.Range("A2:E" & lastRowSource)[/code]

Ezt a tartományt a Copy metódussal illesszük be az Összesítő fül utolsó utáni sorának A oszlopába.

[code language=”vb”]rngCopy.Copy shtAll.Range("A" & lastRowAll + 1)[/code]

Így néz ki a végleges kódunk:

[code language=”vb”]Sub Osszefuzes()

Dim shtAll As Worksheet, sht As Worksheet

Dim lastRowSource As Long, lastRowAll As Long

Dim rngCopy As Range

Set shtAll = Sheets("Összesitö")

shtAll.Rows("2:" & Rows.Count).ClearContents

For Each sht In ThisWorkbook.Sheets

If Not sht Is shtAll Then

lastRowSource = sht.Range("A1").CurrentRegion.Rows.Count

lastRowAll = shtAll.Range("A1").CurrentRegion.Rows.Count

Set rngCopy = sht.Range("A2:E" & lastRowSource)

rngCopy.Copy shtAll.Range("A" & lastRowAll + 1)

End If

Next

End Sub[/code]