В тази статия ще създадем макрос за копиране на данни от множество работни книги в папка в нова работна книга.
Ще създадем два макроса; един макрос ще копира само записи от първата колона в новата работна книга, а вторият макрос ще копира всички данни в нея.
Суровите данни за този пример се състоят от записи за присъствие на служители. В TestFolder имаме множество Excel файлове. Имената на файловете на Excel представляват определена дата във формат „ddmmyyyy“.
Всеки файл на Excel съдържа дата, идентификационен номер на служител и име на служител на тези служители, които са присъствали на този конкретен ден.
Създадохме два макроса; „CopyingSingleColumnData“ и „CopyingMultipleColumnData“. Макросът „CopyingSingleColumnData“ ще копира записи само от първата колона на всички файлове в папката в новата работна книга. Макросът „CopyingMultipleColumnData“ ще копира всички данни от всички файлове в папката в новата работна книга.
Макросът „CopyingSingleColumnData“ може да се изпълни, като щракнете върху бутона „Копиране на една колона“. Макросът „CopyingMultipleColumnData“ може да се изпълни, като щракнете върху бутона „Копиране на няколко колони“.
Преди да стартирате макроса, трябва да посочите пътя на папката в текстовото поле, където са поставени Excel файлове.
Когато се натисне бутона „Копиране на една колона“, в определената папка ще бъде генерирана нова работна книга „ConsolidatedFile“. Тази работна книга ще съдържа консолидирани данни от първата колона на всички файлове в папката.
Новата работна книга ще съдържа само записи в първата колона. След като имаме консолидираните данни, можем да разберем броя на служителите, присъстващи на определен ден, като преброим броя на датите. Броят на определена дата ще бъде равен на броя на служителите, присъстващи на този конкретен ден.
Когато се кликне върху бутона „Копиране на няколко колони“, той ще генерира новата работна книга „ConsolidatedAllColumns“ в определената папка. Тази работна книга ще съдържа консолидирани данни от всички записи на всички файлове в папката.
Създадената нова работна книга ще съдържа всички записи от всички файлове в папката. След като имаме консолидираните данни, имаме всички данни за посещаемостта в един файл. Ние лесно можем да намерим броя на служителите, присъстващи на този конкретен ден, както и да получим имената на служителите, които са присъствали на този конкретен ден.
Обяснение на кода
Sheet1.TextBox1.Value
Горният код се използва за получаване на стойността, вмъкната в текстовото поле „TextBox1“ от листа „Sheet1“.
Dir (FolderPath & "*.xlsx")
Горният код се използва за получаване на името на файла, който има разширение на файла „.xlsx“. Използвахме заместващи знаци * за име на файл с няколко знака.
Докато FileName ""
Брой1 = Брой1 + 1
ReDim Preserve FileArray (от 1 до 1)
FileArray (Count1) = FileName
FileName = Dir ()
Венд
Горният код се използва за получаване на имена на всички файлове в папката.
За i = 1 към UBound (FileArray)
Следващия
Горният код се използва за преминаване през всички файлове в папката.
Range ("A1", Cells (LastRow, 1)). Copy DestWB.ActiveSheet.Cells (LastDesRow, 1)
Горният код се използва за копиране на запис от първата колона в целевата работна книга.
Диапазон ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Копиране DestWB.ActiveSheet.Cells (LastDesRow, 1)
Горният код се използва за копиране на целия запис от активната работна книга в работната книга местоназначение.
Моля, следвайте кода по -долу
Опция Изрично подкопиранеSingleColumnData () 'Деклариране на променливи Dim FileName, FolderPath, FileArray (), FileName1 като String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB Като приложение за работна книга.ScreenUpdating = ShellOxPetal1.' Вмъкване на обратна наклонена черта в пътя на папката, ако наклонена черта (\) липсва If Right (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Търсене на Excel файлове FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Преминаване през всички Excel файлове в папката Докато FileName "" Count1 = Count1 + 1 ReDim Запазва FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend "Създаване на нова работна книга Set DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Намиране на последния ред в работната книга LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Отваряне на работната книга на Excel SourceWB = Workbooks.Open (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Copy DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Запазване и затваряне на нов Excel работна книга DestWB.SaveAs FileName: = FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nothing Set SourceWB = Nothing End Sub Sub CopyingMultipleColumnData () 'Деклариране на променливи Dim FileName, FolderPath, FileArrayRay1,, , Count1, i As Integer Dim SourceWB, DestWB As Application на работна книга. = FolderPath & "\" End If "Търсене на Excel файлове FileName = Dir (FolderPath &"*.xlsx ") Count1 = 0 „Преглеждане на всички Excel файлове в папката Докато FileName" "Count1 = Count1 + 1 ReDim Запазва FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend" Създаване на нова работна книга Set DestWB = Workbooks.Add За i = 1 към UBound (FileArray) "Намиране на последния ред в работната книга LastDesRow = DestWB.ActiveSheet.Range (" A1 "). SpecialCells (xlCellTypeLastCell) .Row" Отваряне на работната книга на Excel Задайте SourceWB = Workbooks.Open (FolderPath & FileArray (i)) 'Поставяне на копираните данни в последния ред в целевата работна книга If LastDesRow = 1 then' Копиране на всички данни в работния лист до последния ред в целевия диапазон на работната книга ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Копирайте DestWB.ActiveSheet.Cells (LastDesRow, 1) Друг диапазон ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Копирайте DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Край Ако SourceWB.Cseving. нова работна книга на Excel DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Нищо не е зададено ИзточникWB = Нищо Край Sub
Ако този блог ви е харесал, споделете го с приятелите си във Facebook. Също така можете да ни следвате в Twitter и Facebook.
Ще се радваме да чуем от вас, уведомете ни как можем да подобрим работата си и да я направим по -добра за вас. Пишете ни на имейл сайта