MS Excel

Téma: VBA - kopírování do posledního řádku

Zaslal/a Zly-anonymni-uzivatel 29.7.2019 11:06

Zdravím všechny. Řeším zapeklitý problém a přiznávám, že si už nevím rady.
Dostal jsem se k makru, které do otevřené tabulky nahraje vyplněné řádky ze stejně vypadajících tabulek v určené složce i podsložkách (zkrátka sběr dat). V současném stavu skutečně vezme vyplněné hodnoty (od třetího řádku) a nakopíruje je pod sebe do výchozí tabulky. S jednou výjimkou - pokud někdo nevyplní sloupec A. Takový údaj se sice překopíruje do výchozí tabulky, ale při dalším importu je nahrazen (tj. hodnoty se vždy nahrají do první volné buňky ve sloupci A. Nevíte jak udělat, aby vycházel z posledního volného řádku (berouc v potaz více sloupců)? Předem velké díky.

Dim fNAME As String: fNAME = "xxx.xlsm"
Dim fPATH As String: fPATH = "D:\xxx\
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim FLD As Object: Set FLD = FSO.GetFolder(fPATH)
Dim SubFLDRS As Object: Set SubFLDRS = FLD.SubFolders
Dim SubFLD As Object
Dim wbMain As Workbook: Set wbMain = ThisWorkbook
Dim wbData As Workbook
Dim ws As Worksheet
Dim LR As Long

For Each SubFLD In SubFLDRS
Set wbData = Workbooks.Open(fPATH & SubFLD.Name & "\" & fNAME)

For Each ws In ActiveWorkbook.Worksheets
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A3:P3" & LR).EntireRow.Copy
wbMain.Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Next ws

Application.CutCopyMode = False
wbData.Close False
Next SubFLD

Set wbMain = Nothing
End Sub

Zaslat odpověď >

elninoslov(4.8.2019 0:05)#043865

Príloha žiadna. Ani riadiaci súbor, ani dátový súbor, ani štruktúra zložky, ani podrobnosti o umiestnení ostatných dát v zošitoch, ani počte listov. Dokonca ani to uvedené makro nieje celé.

Makro nijako neskúšam, lebo vytvárať si preň prostredie nebudem. Tak len na pohľad:

"v určené složce i podsložkách (zkrátka sběr dat)" - Nevidím síce celé makro, ale o tom pochybujem. To musí byť rekurzívna metóda, aby prešla všetky zložky a ich podzložky atď, a tu navyše nekontroluje ani hlavnú zložku.

LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A3:P3" & LR).EntireRow.Copy
To je zle! Veď do LR sa uloží posledný vyplnený riadok v A:A dolovaného listu. Tak napr. 10. Ale kopírovaná oblasť bude A3:P310 - vďaka tej napísanej 3-ojke. O možnom nevyplnenom údaji v stĺpci A:A hovoríte v suvislosti s týmto dolovaným listom, alebo s nasledujúcim riadkom ? :

wbMain.Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Lebo tento riadok na prvý pohľad robí tú Vašu "chybu". Nemôžete skúmať ...End(xlUp)... pri každom prechode v stĺpci A:A, lebo môže byť nevyplnený. Namiesto toho si nadefinujte premennú
Dim RiadokZapisu As Long
ale kde a ako ju použiť záleží na celej koncepcii makra, ktoré nevidíme. Napr. môže byť potreba globálna premenná v prípade miltiprocedurálneho makra, alebo lokálna ak je to len 1 procedúra. V nej napr. predpokladajme, že má združená tabuľka hlavičku.

Ďalej čítajte počet riadkov podľa použitej oblasti (neberie ohľad iba na stĺpec A:A, ale tiež záleží na usporiadaní dolovaných dát, ktoré nevidíme)
UsedRange.Rows.Count + 1
a teda namiesto
wbMain.Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
dajte napr. (odbrucha bez skúšania !)
RiadokZapisu = wbMain.Sheets(ws.Name).UsedRange.Rows.Count + 1
wbMain.Sheets(ws.Name).Range("A" & RiadokZapisu).PasteSpecial xlPasteValues

Každopádne ak sa jedná o zber dát, tak rozhodne nieje na mieste robiť Copy Paste s formátmi buniek a pod, ale stačí iba hodnoty čítať - to bude rýchlejšie. Ďalej by som to asi robil poľom a zapisoval naraz, nie po jednom - opäť urýchlenie.

Každopádne na takéto všelijaké dolovanie dát je vhodný PowerQuery, ktorý by Vám tu možno aj niektorí borci pomohli urobiť, ale bez príkladových súborov určo nie ...
...citovat

Téma: VBA - kopírování do posledního řádku

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje