Makro łączenie plików excel , kilka linijek kodu VBA pozwala zaoszczędzić wiele cennego czasu. Inspiracją była koleżanka z pracy, która miała taki case. Otrzymywała pliki o tej samej strukturze w formie csv, każdego dnia od dostawcy, zawierające informacje np. o przesyłkach. Wciągu miesiąca plików uzbierało się ponad 20. Importowanie każdego oddzielnie pochłania mnóstwo czasu. Z pomocą przychodzi VBA, kilka linijek kodu poniżej, wystarczy przestudiować. W załączeniu jest gotowy plik do pobrania.
Jak scalić pliki csv makro łączenie plików excel?
Jak to działa?
- Umieszczamy plik scala.xlsm w katalogu z plikami csv.
- Otwieramy plik scala.xlsm, naciskamy baton „Scal CSV”
- I gotowe, powstaje nowy plik o nazwie „scalone.csv”, który zawiera dane ze wszystkich plików o rozszerzeniu CSV mieszczących się w folderze.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
Sub scalaj_csv() Dim NazwaPlik As String ' zdefiniowanie zmiennej do przechowywania nazwy pliku Dim Lokalizacja As String ' zdefiniowanie zmiennej do przechowywania scieżki do katalogu Dim wbWyniki As Workbook ' skoroszyt gdzie będą wyniki Dim wbCSV As Workbook ' oryginalne skoroszyty z których będziemy kopiować Dim wiersz As Integer ' zdefiniowanie zmiennej typu liczbowego Lokalizacja = ThisWorkbook.Path & '\' 'Lokalizacja pliku NazwaPlik = Dir(Lokalizacja & "*.csv*") 'pobranie nazwy pliku csv Application.ScreenUpdating = False 'wyłączenie odświeżania Application.EnableEvents = False 'wyłaczenie obsługi zdarzeń Set wbWyniki = Workbooks.Add(xlWorksheet) 'storzenie nowego skoroszytu gdzie będziemy zapisywać i = 1 ' przypisanie zmiennej i wartości 1 ' uruchomienie pętli, która będzie się wykonywała aż warunek bedzie spełniony Do While NazwaPlik <> vbNullString Set wbCSV = Workbooks.Open(Filename:=Lokalizacja & NazwaPlik, ReadOnly:=True) 'otwieranie pliku csv NazwaPlik = Left((Left(NazwaPlik, Len(NazwaPlik) - 5)), 29) 'wyciagniecie nazwy pliku bez roszeżenia wbCSV.Activate ' aktywacja pliku CSV ' przy pierwszym kopiowaniu, kopiujemy nagłówek, przy kolejnych plikach omijamy nagłóweg If i = 1 Then Range("A1").Select ' wiersz z nagłówkiem Else Range("A2").Select ' omijamy nagłówek End If Range(Selection, Selection.End(xlDown)).Select ' zaznaczenie zakresu do skopiowania Selection.Copy 'kopiowanie wbWyniki.Activate 'aktywacja pliku z wynikami wiersz = Cells(Rows.Count, 1).End(xlUp).Row 'policzenie wypełnionych wierszy Cells(wiersz, 1).Select 'przejście do ostatniego wypełnionego wiersza ActiveCell.Offset(1, 0).Select ' przejście o 1 wiersz niżej od aktywnej komórki ActiveSheet.Paste 'wklejenie danych z pliku CSV wbCSV.Close SaveChanges:=False ' zamknięcie pliku CSV NazwaPlik = Dir 'pobranie nazwy pliku i = 2 ' zmiana wartości zmiennej i Loop Application.DisplayAlerts = False 'włączenie komunikatów wbWyniki.SaveAs Filename:=Lokalizacja & "scalone", FileFormat:=xlCSVMSDOS, CreateBackup:=False ' zapisanie pliku finalnego wbWyniki.Close SaveChanges:=False 'zamknięcie pliku finalnego Application.DisplayAlerts = True ' włączenie kominukatów Application.ScreenUpdating = True ' włączenie odświeżania Application.EnableEvents = True ' włączenie obsługi zdarzeń Set wbWyniki = Nothing ' zwolnienie pamieci z zmiennej obiektowej MsgBox "Pliki scalone" ThisWorkbook.Close SaveChanges:=False End Sub |
Zachęcam to pisania komentarzy. Jeśli ktoś uzna, że warto by rozszerzyć działanie makra do zachęcam do kontaktu najlepiej drogą email.
Jeśli podobał Ci się artykuł to daj Lajka, w ten sposób pomożesz dotrzeć innym do tego artykuły. Zachęcam Cie również do zapisania się na newsletter, znajdziesz go po prawej stronie strony.
Ostatnie artykuły Adam Kubański (Wszystkie)
- #3 Excel Tips&Tricks – szybkie wklej - 19 listopada, 2019
- #2 Excel Tips&Tricks – zaznacz komórki zawierające - 10 listopada, 2019
- Excel Tips&Tricks – Sortowanie po liście - 7 listopada, 2019
Czy może jakaś opcja z XLSX 😉 ?
Proszę zmienić w kodzie rozszerzenie z csv na xlsx. Powinno zadziałać.
CurFile = Dir(DirLoc & „*.xlsx*”)
Hej,
zmieniłabym nazwę pliku, aby nie tylko rozszerzenia csv mogły byc brane pod uwagę
NazwaPlik = Left(NazwaPlik, Application.Find(„.” , NazwaPlik)-1)
Pozdrawiam
U mnie zmiana początku:
Dim A As FileDialog
On Error Resume Next 'wybieranie plików poprzez wskazanie folderu
Set A = Application.FileDialog(msoFileDialogFolderPicker)
A.Show
Debug.Print A.SelectedItems(1)
On Error GoTo 0
Lokalizacja = A.SelectedItems(1) & „\” ’ Lokalizacja pliku
spowodowała, że mogę wskazać folder zawierający pliki do scalania.
Bardzo dobry pomysł, może ktoś skorzysta 🙂
Lokalizacja = A.SelectedItems(1) & „\” ’ Lokalizacja pliku —– to mam na czerwono, jaki jest błąd?
Już znalazłem, skasowałem apostrof i komentarz i jest dobrze
dzień dobry,
potrzebuję takiego samego skryptu do połączenia plików excela. Czy mogę liczyć na Pana pomoc?
Proszę zmienić w kodzie rozszerzenie z csv na xlsx. Powinno zadziałać.
CurFile = Dir(DirLoc & „*.xlsx*”)