W tym artykule utworzymy makro do kopiowania danych z wielu skoroszytów w folderze do nowego skoroszytu.
Stworzymy dwa makra; jedno makro skopiuje tylko rekordy z pierwszej kolumny do nowego skoroszytu, a drugie makro skopiuje do niego wszystkie dane.
Surowe dane dla tego przykładu składają się z rekordów obecności pracowników. W TestFolder mamy wiele plików Excela. Nazwy plików plików Excel reprezentują określoną datę w formacie „ddmmyyyy”.
Każdy plik Excel zawiera datę, identyfikator pracownika oraz imię i nazwisko pracowników, którzy byli obecni w danym dniu.
Stworzyliśmy dwa makra; „Kopiowanie danych pojedynczych kolumn” i „Kopiowanie danych wielu kolumn”. Makro „CopyingSingleColumnData” skopiuje tylko rekordy z pierwszej kolumny wszystkich plików w folderze do nowego skoroszytu. Makro „CopyingMultipleColumnData” skopiuje wszystkie dane ze wszystkich plików w folderze do nowego skoroszytu.
Makro „CopyingSingleColumnData” można wykonać, klikając przycisk „Kopiowanie pojedynczej kolumny”. Makro „CopyingMultipleColumnData” można wykonać, klikając przycisk „Kopiowanie wielu kolumn”.
Przed uruchomieniem makra należy w polu tekstowym określić ścieżkę do folderu, w którym znajdują się pliki Excel.
Po kliknięciu przycisku „Kopiowanie pojedynczej kolumny” w zdefiniowanym folderze zostanie wygenerowany nowy skoroszyt „Skonsolidowany plik”. Ten skoroszyt będzie zawierał skonsolidowane dane z pierwszej kolumny wszystkich plików w folderze.
Nowy skoroszyt będzie zawierał tylko rekordy w pierwszej kolumnie. Mając dane skonsolidowane, możemy obliczyć liczbę pracowników obecnych w danym dniu, licząc liczbę dat. Liczba w określonym dniu będzie równa liczbie pracowników obecnych w danym dniu.
Po kliknięciu przycisku „Kopiowanie wielu kolumn” wygeneruje nowy skoroszyt „ConsolidatedAllColumns” w zdefiniowanym folderze. Ten skoroszyt będzie zawierał skonsolidowane dane ze wszystkich rekordów wszystkich plików w folderze.
Utworzony nowy skoroszyt będzie zawierał wszystkie rekordy ze wszystkich plików w folderze. Gdy mamy skonsolidowane dane, wszystkie szczegóły dotyczące obecności mamy dostępne w jednym pliku. Możemy łatwo znaleźć liczbę pracowników obecnych w danym dniu, a także uzyskać nazwiska pracowników, którzy byli obecni w tym dniu.
Wyjaśnienie kodu
Arkusz1.Pole tekstowe1.Wartość
Powyższy kod służy do pobrania wartości wstawionej w polu tekstowym „TextBox1” z arkusza „Sheet1”.
Katalog(ŚcieżkaFolderu & "*.xlsx")
Powyższy kod służy do pobrania nazwy pliku, który ma rozszerzenie „.xlsx”. Użyliśmy symbolu wieloznacznego * dla nazwy pliku z wieloma znakami.
Podczas gdy nazwa pliku „”
Count1 = Count1 + 1
ReDim Zachowaj FileArray (1 do Count1)
FileArray(Count1) = NazwaPliku
NazwaPliku = Katalog()
Wend
Powyższy kod służy do pobierania nazw wszystkich plików w folderze.
For i = 1 To UBound(FileArray)
Następny
Powyższy kod służy do przeglądania wszystkich plików w folderze.
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Powyższy kod służy do kopiowania rekordu z pierwszej kolumny do skoroszytu docelowego.
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Powyższy kod służy do kopiowania całego rekordu z aktywnego skoroszytu do skoroszytu docelowego.
Proszę postępować zgodnie z poniższym kodem!
Option Explicit Sub CopyingSingleColumnData() 'Deklarowanie zmiennych Dim FileName, FolderPath, FileArray(), FileName1 As String Dim LastRow, LastDesRow, Count1, i As Integer Dim SourceWB, DestWB As skoroszyt Application.ScreenUpdating = False FolderPath = Sheet1.TextBox'1. Wstawianie odwrotnego ukośnika w ścieżce folderu, jeśli brakuje odwrotnego ukośnika (\) If Right(FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Wyszukiwanie plików Excela FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Przechodzenie w pętlę przez wszystkie pliki Excela w folderze While FileName "" Count1 = Count1 + 1 ReDim Zachowaj FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Tworzenie nowego skoroszytu Set DestWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Znajdowanie ostatniego wiersza w skoroszycie LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Otwieranie skoroszytu programu Excel Set SourceWB = Workbooks.Open (FolderPath i FileArray(i)) LastRow = ActiveCell.SpecialCells(xlCellTypeLas tCell).Row 'Wklejanie skopiowanych danych do ostatniego wiersza w skoroszycie docelowym If LastDesRow = 1 Then 'Kopiowanie pierwszej kolumny do ostatniego wiersza w skoroszycie docelowym Range("A1", Cells(LastRow, 1)).Copy DestWB. ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Next 'Zapisywanie i zamykanie nowego Excela workbook DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx" DestWB.Close Set DestWB = Nic nie ustawiono SourceWB = Nic nie kończy Sub CopyingMultipleColumnData() 'Deklarowanie zmiennych Dim FileName, FolderPath, FileArray(), FileName1 As String Dim LastRowow, LastDes , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Wstawianie odwrotnego ukośnika w ścieżce folderu, jeśli brakuje odwrotnego ukośnika (\) If Right(FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Wyszukiwanie plików Excel FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Przechodzenie przez wszystkie pliki Excela w folderze While FileName "" Count1 = Count1 + 1 ReDim Zachowaj FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend 'Tworzenie nowego skoroszytu Set DestWB = Workbooks.Add For i = 1 To UBound(FileArray) 'Znajdowanie ostatniego wiersza w skoroszycie LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Otwieranie skoroszytu programu Excel Set SourceWB = Workbooks.Open(FolderPath & FileArray(i)) 'Wklejanie skopiowanych danych do ostatniego wiersza w skoroszycie docelowym If LastDesRow = 1 Then 'Kopiowanie wszystkich danych w arkuszu do ostatniego wiersza w skoroszycie docelowym Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)). Skopiuj DestWB.ActiveSheet.Cells(LastDesRow, 1) Else Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Skopiuj DestWB.ActiveSheet.Cells(LastDesRow + 1, 1) End If SourceWB.Close False Next 'Zapisywanie i zamykanie nowy skoroszyt programu Excel DestWB.SaveAs FileName:=FolderPath & „ConsolidatedAllColumns.xlsx” DestWB.Close Set D estWB = Nic nie ustawiono SourceWB = Nic Koniec Sub
Jeśli podobał Ci się ten blog, podziel się nim ze znajomymi na Facebooku. Możesz również śledzić nas na Twitterze i Facebooku.
Chcielibyśmy usłyszeć od Ciebie, daj nam znać, jak możemy poprawić naszą pracę i uczynić ją lepszą dla Ciebie. Napisz do nas na stronie e-mail