V tomto článku vytvoríme makro na kopírovanie údajov z viacerých zošitov v priečinku do nového zošita.
Vytvoríme dve makrá; jedno makro skopíruje iba záznamy z prvého stĺpca do nového zošita a druhé makro do neho skopíruje všetky údaje.
Surové údaje pre tento príklad pozostávajú zo záznamov o dochádzke zamestnancov. V TestFolder máme viac súborov programu Excel. Názvy súborov súborov programu Excel predstavujú konkrétny dátum vo formáte „ddmmyyyy“.
Každý súbor programu Excel obsahuje dátum, ID zamestnanca a meno zamestnanca tých zamestnancov, ktorí boli v daný deň prítomní.
Vytvorili sme dve makrá; „CopyingSingleColumnData“ a „CopyingMultipleColumnData“. Makro „CopyingSingleColumnData“ skopíruje do nového zošita iba záznamy z prvého stĺpca všetkých súborov v priečinku. Makro „CopyingMultipleColumnData“ skopíruje všetky údaje zo všetkých súborov v priečinku do nového zošita.
Makro „CopyingSingleColumnData“ je možné vykonať kliknutím na tlačidlo „Kopírovanie jedného stĺpca“. Makro „CopyingMultipleColumnData“ je možné vykonať kliknutím na tlačidlo „Kopírovanie viacerých stĺpcov“.
Pred spustením makra je potrebné zadať cestu k priečinku do textového poľa, kde sú umiestnené súbory programu Excel.
Po kliknutí na tlačidlo „Kopírovanie jedného stĺpca“ sa v definovanom priečinku vygeneruje nový zošit „ConsolidatedFile“. Tento zošit bude obsahovať konsolidované údaje z prvého stĺpca všetkých súborov v priečinku.
Nový zošit bude obsahovať iba záznamy v prvom stĺpci. Keď máme konsolidované údaje, môžeme zistiť počet zamestnancov prítomných v konkrétny deň spočítaním dátumu. Počet konkrétneho dátumu sa bude rovnať počtu zamestnancov prítomných v daný deň.
Po kliknutí na tlačidlo „Kopírovanie viacerých stĺpcov“ sa v definovanom priečinku vygeneruje nový zošit „ConsolidatedAllColumns“. Tento zošit bude obsahovať konsolidované údaje zo všetkých záznamov všetkých súborov v priečinku.
Nový vytvorený zošit bude obsahovať všetky záznamy zo všetkých súborov v priečinku. Keď máme konsolidované údaje, máme k dispozícii všetky podrobnosti o dochádzke v jednom súbore. Ľahko nájdeme počet zamestnancov prítomných v ten konkrétny deň a tiež získame mená zamestnancov, ktorí boli v ten konkrétny deň prítomní.
Vysvetlenie kódu
List1.TextBox1.Hodnota
Vyššie uvedený kód slúži na vloženie hodnoty do textového poľa „TextBox1“ z listu „List1“.
Dir (FolderPath & "*.xlsx")
Vyššie uvedený kód sa používa na získanie názvu súboru s príponou súboru „.xlsx“. Na názov súboru s viacerými znakmi sme použili zástupný znak *.
Kým názov súboru ""
Count1 = Count1 + 1
ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName
FileName = Dir ()
Wend
Vyššie uvedený kód sa používa na získanie názvov súborov všetkých súborov v priečinku.
Pre i = 1 až UBound (FileArray)
Ďalšie
Vyššie uvedený kód sa používa na prepínanie medzi všetkými súbormi v priečinku.
Rozsah ("A1", bunky (LastRow, 1)). Skopírujte DestWB.ActiveSheet.Cells (LastDesRow, 1)
Vyššie uvedený kód sa používa na kopírovanie záznamu z prvého stĺpca do cieľového zošita.
Rozsah ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Skopírujte DestWB.ActiveSheet.Cells (LastDesRow, 1)
Vyššie uvedený kód sa používa na kopírovanie všetkých záznamov z aktívneho zošita do cieľového zošita.
Pri kódovaní postupujte podľa nižšie uvedených pokynov
Možnosť Explicitné čiastkové kopírovanieSingleColumnData () 'Deklarovanie premenných Dim FileName, FolderPath, FileArray (), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.Text Vloženie spätného lomítka do cesty k priečinku, ak chýba spätné lomítko (\) Ak správne (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Hľadanie súborov programu Excel Názov_súboru = Dir (FolderPath & "*.xlsx") Count1 = 0 'Opakovanie všetkých súborov programu Excel v priečinku, zatiaľ čo FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Create a new workbook Set DestWB = Zošity. Pridať pre i = 1 do UBound (FileArray) „Nájdenie posledného riadka v zošite LastDesRow = DestWB.ActiveSheet.Range (" A1 "). SpecialCells (xlCellTypeLastCell). Riadok" Otvorenie zošita programu Excel Nastaviť SourceWB = zošity. Otvoriť (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell). Riadok 'Vloženie skopírovaných údajov do posledného riadka v cieľovom zošite, ak LastDesRow = 1 Potom' Skopírovanie prvého stĺpca do posledného riadka v cieľovom zošite Rozsah („A1“, bunky (LastRow, 1)). Skopírujte DestWB. ActiveSheet.Cells (LastDesRow, 1) Iný rozsah ("A1", bunky (LastRow, 1)). Skopírujte DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Uloženie a zatvorenie nového Excelu zošit DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub CopyingMultipleColumnData () 'Declaring variables Dim FileName, FolderPath, FileArray (), FileName1 As String Dim LastRow "Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Inserting backslash in the folder path if backslash (\) is if Right (FolderPath, 1)" \ "Then FolderPath = FolderPath & "\" End If 'Hľadanie súborov programu Excel FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Opakovanie všetkých súborov programu Excel v priečinku Kým názov súboru "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Vytvorenie nového zošita Set DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Finding the last row in the workbook LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Opening the Excel workbook Set SourceWB = Workbooks.Open (FolderPath & FileArray (i)) 'Vloženie skopírovaných údajov do posledného riadka v cieľovom zošite, ak LastDesRow = 1 Potom' Skopírovanie všetkých údajov v pracovnom hárku do posledného riadka v cieľovom zošite Rozsah („A1“, ActiveCell.SpecialCells (xlCellTypeLastCell)). Skopírujte DestWB.ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Copy DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Ukladanie a zatváranie nový excelový zošit DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nič nie je nastavené SourceWB = Nič sa nekončí
Ak sa vám tento blog páčil, zdieľajte ho so svojimi priateľmi na Facebooku. Môžete nás tiež sledovať na Twitteri a Facebooku.
Budeme radi, ak sa nám ozvete, dajte nám vedieť, ako môžeme zlepšiť našu prácu a zlepšiť ju pre vás. Napíšte nám na emailovú stránku