Kezdőlap › Fórumok › Excel programozás › [Resolved] VBA – adatok kigyűjtése külön munkalapra
- This topic has 5 hozzászólás, 3 résztvevő, and was last updated 5 years, 9 months telt el by
kovacsl1968.
-
SzerzőBejegyzés
-
2019-01-30-13:26 #5578
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 + 1End 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 IfNext i
End If
End SubElőre is köszönöm ha valakinek van épkézláb ötlete…
2019-01-30-16:24 #5579A 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 Sub2019-01-30-23:23 #5583Ez 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.2019-02-07-09:06 #5588Köszönöm a segítséget!
2019-02-12-08:00 #5607Sziasztok!
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 LongSheets(„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.
2019-02-12-08:17 #5608Helyesbítek… Működik. 🙂 Persze, hogy bénáztam, de sikerült az adaptáció. Ezer köszi!
-
SzerzőBejegyzés
- Be kell jelentkezni a hozzászóláshoz.
