În acest articol, vom crea o macrocomandă pentru a copia date din mai multe registre de lucru dintr-un folder într-un registru de lucru nou.
Vom crea două macrocomenzi; o macrocomandă va copia numai înregistrările din prima coloană în noul registru de lucru și a doua macrocopie va copia toate datele în ea.
Datele brute pentru acest exemplu constau în înregistrări de prezență ale angajaților. În TestFolder, avem mai multe fișiere Excel. Numele de fișiere ale fișierelor Excel reprezintă o anumită dată în format „ddmmyyyy”.
Fiecare fișier Excel conține data, ID-ul angajatului și numele angajatului acelor angajați care au fost prezenți în acea zi anume.
Am creat două macrocomenzi; „CopyingSingleColumnData” și „CopyingMultipleColumnData”. Macrocomanda „CopyingSingleColumnData” va copia numai înregistrările din prima coloană a tuturor fișierelor din folder în noul registru de lucru. Macrocomanda „CopyingMultipleColumnData” va copia toate datele din toate fișierele din folder în noul registru de lucru.
Macrocomanda „CopyingSingleColumnData” poate fi executată făcând clic pe butonul „Copying Single Column”. Macro-ul „CopyingMultipleColumnData” poate fi executat făcând clic pe butonul „Copierea mai multor coloane”.
Înainte de a rula macro-ul, trebuie să specificați calea folderului în caseta de text, unde sunt plasate fișierele Excel.
Când se face clic pe butonul „Copierea unei singure coloane”, un nou registru de lucru „ConsolidatedFile” va fi generat în folderul definit. Acest registru de lucru va conține date consolidate din prima coloană a tuturor fișierelor din folder.
Noul registru de lucru va conține numai înregistrări din prima coloană. Odată ce avem datele consolidate, putem afla numărul de angajați prezenți într-o anumită zi, numărând numărul datei. Numărul unei anumite date va fi egal cu numărul de angajați prezenți în acea zi.
Când se face clic pe butonul „Copierea mai multor coloane”, acesta va genera noul registru de lucru „ConsolidatedAllColumns” în folderul definit. Acest registru de lucru va conține date consolidate din toate înregistrările tuturor fișierelor din folder.
Noul registru de lucru creat va conține toate înregistrările din toate fișierele din dosar. Odată ce avem datele consolidate, avem toate detaliile prezenței disponibile într-un singur fișier. Putem găsi cu ușurință numărul de angajați prezenți în acea zi și, de asemenea, putem obține numele angajaților care au fost prezenți în acea zi.
Explicarea codului
Sheet1.TextBox1.Value
Codul de mai sus este utilizat pentru a obține valoarea inserată în caseta de text „TextBox1” din foaia „Sheet1”.
Dir (FolderPath & "* .xlsx")
Codul de mai sus este utilizat pentru a obține numele fișierului, care are extensia de fișier „.xlsx”. Am folosit wildcard * pentru numele fișierului cu mai multe caractere.
În timp ce FileName ""
Număr 1 = Număr 1 + 1
ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName
FileName = Dir ()
Merge încet
Codul de mai sus este utilizat pentru a obține numele fișierelor tuturor fișierelor din folder.
Pentru i = 1 la UBound (FileArray)
Următorul
Codul de mai sus este utilizat pentru a parcurge toate fișierele din folder.
Range ("A1", Cells (LastRow, 1)). Copiați DestWB.ActiveSheet.Cells (LastDesRow, 1)
Codul de mai sus este utilizat pentru a copia înregistrarea din prima coloană în registrul de lucru de destinație.
Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiați DestWB.ActiveSheet.Cells (LastDesRow, 1)
Codul de mai sus este utilizat pentru a copia toate înregistrările din registrul de lucru activ în registrul de lucru de destinație.
Vă rugăm să urmați codul de mai jos
Opțiune Explicit Sub CopyingSingleColumnData () 'Declararea variabilelor Dim FileName, FolderPath, FileArray (), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox' Inserarea backslash în calea folderului dacă backslash (\) lipsește Dacă Right (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Căutarea fișierelor Excel FileName = Dir (FolderPath & "* .xlsx") Count1 = 0 'Buclarea prin toate fișierele Excel din folder În timp ce FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Crearea unui nou registru de lucru Set DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Găsirea ultimului rând din registrul de lucru LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell). Rândul' Deschiderea registrului Excel Set SourceWB = Workbooks.Open (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Lipirea datelor copiate în ultimul rând din registrul de lucru de destinație If LastDesRow = 1 Apoi' Copierea primei coloane în ultimul rând din intervalul de registru de lucru de destinație („A1”, Celule (LastRow, 1)). Copiați DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Copiați DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Salvarea și închiderea unui nou Excel registru de lucru DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData () 'Declaring variables Dim FileName, FolderPath, FileArray (), FileName1 As StringD LastRow, 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 (\) missing If Right (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Căutarea fișierelor Excel FileName = Dir (FolderPath & "* .xlsx") Count1 = 0 'Buclarea prin toate fișierele Excel din folderul În timp ce FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Crearea unui nou registru de lucru Set DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Găsirea ultimului rând din registrul de lucru LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell). FileArray (i)) 'Lipirea datelor copiate în ultimul rând din registrul de lucru de destinație If LastDesRow = 1 Apoi' Copierea tuturor datelor din foaia de lucru în ultimul rând din intervalul de registru de lucru de destinație ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiați DestWB.ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Copiați DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Salvare și închidere un nou registru de lucru Excel DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nothing Set Source WB = Nothing End Sub
Dacă ți-a plăcut acest blog, distribuie-l prietenilor tăi de pe Facebook. De asemenea, ne puteți urmări pe Twitter și Facebook.
Ne-ar plăcea să aflăm de la dvs., să ne anunțați cum putem îmbunătăți munca noastră și o putem îmbunătăți. Scrieți-ne pe site-ul de e-mail
