Telefonszámunk: 1-472-0679

[Resolved] VBA – adatok kigyűjtése külön munkalapra

Kezdőlap Fórumok Excel programozás [Resolved] VBA – adatok kigyűjtése külön munkalapra

Topic Resolution: Resolved

Ennek a témakörnek tartalma 5 hozzászólás, 3 résztvevő. Utolsó frissítés:  kovacsl1968 6 hónapja, 1 hét telt el.

6 bejegyzés megtekintése - 1-6 / 6
  • Szerző
    Bejegyzés
  • #5578

    kovacsl1968
    Felhasználó

    Sziasztok!
    Előrebocsátom, barátkoznék én a makrózással, csak ő éppen nem nagyon szeretné ezt… Találtam ehhez hasonlót korábban, de ott tömbös adatokról volt szó… A következő problémám van. Adva van egy terjedelmes táblázat, mondjuk 6000 sor és kb 25 oszlop. Ami engem érdekelne mint feladat, az úgy néz ki, hogy a Q oszlopban nem mindig van adat. Azt szeretném, hogy amikor itt van adat, akkor az adott sor G és H oszlopaiból átmásolja az adatokat egy új munkalapra. Erre az új lapra készítettem egy két soros (fejléc + egy sor) és két oszlopos formázott táblázatot azért, hogy az átmásolt növekvő adatmennyiséget mindig táblázatként kezelje, ebből készíteném a kimutatást. Próbáltam a szűrési folyamatot makrózni, nem volt egy sikertörténet. Megpróbáltam manuálisan is alkotni valamit, de valamit biztos elszúrok, mert nem működik (röhögni nem ér):

    Sub tel()

    ‘ tel Makró


    Application.ScreenUpdating = False
    Sheets(“Telefonálók”).Select
    Range(“A2”).Select
    For i = 2 To 1000
    Munka6.Cells(i, 1).Value = “”
    Next i
    Sheets(“Garászmesteri jelentés”).Select
    Range(“Q5”).Select
    For i = 5 To 6000
    If Munka1.Cells(i, 17) = “” Then
    i = i + 1

    End If
    Next i
    If Munka1.Cells(i, 17) <> “” Then
    Munka1.Cells(i, 7).Select
    Selection.Copy
    Sheets(“Telefonálók”).Select
    Range(“A2”).Select
    For i = 2 To 1000
    If Munka6.Cells(i, 1) <> “” Then
    i = i + 1
    ‘Next i
    End If
    If Munka6.Cells(i, 1) = “” Then
    Selection.Paste
    ‘Next i
    End If

    Next i

    End If
    End Sub

    Előre is köszönöm ha valakinek van épkézláb ötlete…

    #5579

    delila
    Felhasználó

    A lap neve, ahonnan másolsz: “Eredeti”, ahova pedig: “Új munkalap”.

    Sub Masolas()
        Dim sor As Long, usor As Long, ide As Long
        
        Sheets("Eredeti").Select
        ide = 3
        usor = Sheets("Eredeti").Range("A" & Rows.Count).End(xlUp).Row
        For sor = 2 To usor
            If Cells(sor, "Q") > "" Then
                Sheets("Új munkalap").Cells(ide, "A") = Cells(sor, "G")
                Sheets("Új munkalap").Cells(ide, "B") = Cells(sor, "H")
                ide = ide + 1
            End If
        Next
    End Sub
    #5583

    horvimi
    Adminisztrátor

    Ez teljesen jó, amit Delila írt.
    Én csak annyit tennék hozzá, hogy ezt meglátásom szerint egy sima irányított / speciális szűréssel meg lehet csinálni. Csak az a feltétel, hogy a Q oszlopban nincs semmi.

    Mivel mindig újra fut, és a teljes 6000+ táblát szűri, ezért a táblázat nem feltétlenül indokolt.
    Bár azt is meg lehet csinálni, hogy az eredmény lapon minden futás előtt törlöd a már ott lévő korábbi futás eredményét.

    #5588

    kovacsl1968
    Felhasználó

    Köszönöm a segítséget!

    #5607

    kovacsl1968
    Felhasználó

    Sziasztok!
    Nos próbáltam adaptálni a fenti makrót a sajátosságok figyelembe vételével sajnos nem történik semmi. Nem dob ki hibaüzenetet, de nem is csinál semmit.
    Így néz ki az én verzióm:

    >>>
    Sub Masolas()
    Dim sor As Long, usor As Long, i As Long

    Sheets(“Garázsmesteri jelentés”).Select
    i = 5
    usor = Sheets(“Garázsmesteri jelentés”).Range(“A” & Rows.Count).End(xlUp).Row
    For sor = 5 To usor
    If Cells(sor, “Q”) > “” Then
    Sheets(“Telefonálók”).Cells(i, “A”) = Cells(i, “G”)
    Sheets(“Telefonálók”).Cells(i, “B”) = Cells(i, “H”)
    i = i + 1
    End If
    Next
    End Sub
    <<<

    A “Garázsmesteri jelentésből” veszem az adatokat, az 5. sortól… Mit bénáztam már megint el? 🙁

    Köszi.

    #5608

    kovacsl1968
    Felhasználó

    Helyesbítek… Működik. 🙂 Persze, hogy bénáztam, de sikerült az adaptáció. Ezer köszi!

6 bejegyzés megtekintése - 1-6 / 6

Be kell jelentkezni a hozzászóláshoz.