Note: The other languages of the website are Google-translated. Back to English

Jak uruchomić makro w tym samym czasie w wielu plikach skoroszytu?

W tym artykule omówię, jak uruchomić makro w wielu plikach skoroszytu w tym samym czasie bez ich otwierania. Poniższa metoda może pomóc w rozwiązaniu tego zadania w programie Excel.

Uruchom makro jednocześnie w wielu skoroszytach z kodem VBA


Uruchom makro jednocześnie w wielu skoroszytach z kodem VBA

Aby uruchomić makro w wielu skoroszytach bez ich otwierania, zastosuj następujący kod VBA:

1. Przytrzymaj ALT + F11 klawisze, aby otworzyć Microsoft Visual Basic for Applications okno.

2, Kliknij wstawka > Modułi wklej następujące makro w Moduł Okno.

Kod VBA: uruchom to samo makro na wielu skoroszytach w tym samym czasie:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Uwagi: W powyższym kodzie skopiuj i wklej własny kod bez rozszerzenia Podłoże nagłówek i End Sub stopka między With Workbooks.Open (xFdItem & xFileName) i Kończyć z skrypty. Zobacz zrzut ekranu:

doc uruchom makro wiele plików 1

3. Następnie naciśnij F5 klucz do wykonania tego kodu oraz a Przeglądaj zostanie wyświetlone okno, wybierz folder zawierający skoroszyty, do których chcesz zastosować to makro, zobacz zrzut ekranu:

doc uruchom makro wiele plików 2

4. A następnie kliknij OK przycisk, żądane makro zostanie wykonane od razu z jednego skoroszytu do drugiego.

 


Najlepsze narzędzia biurowe

Kutools dla programu Excel rozwiązuje większość problemów i zwiększa produktywność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2021 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowa bezpłatna wersja próbna. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół

 

Sortuj komentarze według
Komentarze (43)
Znamionowy 4.5 z 5 · 1 oceny
Ten komentarz został zminimalizowany przez moderatora na stronie
Bardzo przydatne makro i działa dobrze, ale chciałbym móc wybrać pliki z tego folderu, na których chcę uruchomić makro? Pliki nie są generowane automatycznie w osobnym folderze i muszę uruchomić różne makra na każdym zestawie plików z tego folderu, a następnie przenieść je z powrotem do folderu początkowego.
Ten komentarz został zminimalizowany przez moderatora na stronie
Postępowałem zgodnie z instrukcjami, ale pojawił się błąd kompilacji „Pętla bez Do”. Czego mi brakuje? Mój kod makr jest bardzo prosty, wystarczy zmienić rozmiar czcionki w określonych wierszach. Działa samodzielnie. Oto co mam... proszę o pomoc

Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Wykonaj, gdy xFileName <> ""
With Workbooks.Open (xFdItem & xFileName)
„Twój kod tutaj”
Wiersze("2:8").Wybierz
Z zaznaczeniem. Czcionka
.Name = "Arial"
.Rozmiar = 12
.Przekreślenie = Fałsz
. Indeks górny = Fałsz
.Indeks = Fałsz
. Czcionka konturu = Fałsz
.Cień = Fałsz
.Podkreślenie = xlUnderlineStyleNone
.Kolor = -11518420
.OdcieńIOdcień = 0
.ThemeFont = xlThemeFontBrak
Kończyć z
xNazwaPliku = Katalog
Pętla
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, jarto,
Brakowało Ci skryptu „Zakończ z” na końcu kodu, poprawny powinien wyglądać tak:
Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Wykonaj, gdy xFileName <> ""
With Workbooks.Open (xFdItem & xFileName)
„Twój kod tutaj”
Wiersze("2:8").Wybierz
Z zaznaczeniem. Czcionka
.Name = "Arial"
.Rozmiar = 16
.Przekreślenie = Fałsz
. Indeks górny = Fałsz
.Indeks = Fałsz
. Czcionka konturu = Fałsz
.Cień = Fałsz
.Podkreślenie = xlUnderlineStyleNone
.Kolor = -11518420
.OdcieńIOdcień = 0
.ThemeFont = xlThemeFontBrak
Kończyć z
Kończyć z
xNazwaPliku = Katalog
Pętla
End If
End Sub

Spróbuj, mam nadzieję, że ci pomoże!
Ten komentarz został zminimalizowany przez moderatora na stronie
Bardzo przydatne makro i działa świetnie, ale chciałbym móc wybrać pliki z tego folderu, na których chcę uruchomić makro? Na przykład mam 4 pliki w folderze z innymi plikami Excela i chcę, aby działał tylko na tych 4 określonych plikach. Jak mogę ulepszyć twoje makro, aby pozwolić mi wybrać te 4 pliki z tego folderu?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Joelu,
Aby wyzwolić ten sam kod w określonych skoroszytach, należy zastosować poniższy kod:

Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Dim xFB jako ciąg
Z Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Prawda
.Filtry.Wyczyść
.Filtry.Dodaj "excel", "*.xls*"
.Pokazać
Jeśli .SelectedItems.Count < 1 to wyjdź z sub
Dla lngCount = 1 do .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Jeśli xFileName <> "" Wtedy
Z Workbooks.Open(Filename:=xFileName)
'Twój kod
Kończyć z
End If
Następny lngCount
Kończyć z
End Sub

Spróbuj, mam nadzieję, że ci pomoże!
Ten komentarz został zminimalizowany przez moderatora na stronie
dzięki, był naprawdę pomocny
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć!

Próbuję wstawić swój kod do twojego i kiedy uruchamiam makro, pojawia się następujący komunikat: Błąd wykonania „429”: ActiveX nie może utworzyć obiektu. Proszę doradzić, jak można to naprawić. Dziękuję Ci!

Mój kod:

Ustaw RInput = Zakres("A2:A21")
Ustaw wyjście = zakres ("D2:D22")

Dim A() jako wariant
ReDim A(1 do RInput.Rows.Count, 0)
A = RWartość wejściowa2

Ustaw d = CreateObject("Scripsting.Dictionary")

Dla i = 1 do UBound(A)
Jeśli d.Istnieje(A(i,1)) Wtedy
d(A(i,1)) = d(A(i,1)) + 1
Więcej
d.Dodaj A(i, 1), 1
End If
Dalej
Dla i = 1 do UBound(A)
A(i, 1) = d(A(i, 1))
Dalej

Wyjście = A
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, po pierwsze dziękuję za to makro, dokładnie tego szukałem. Mam jednak jeden problem, czy istnieje sposób na zamknięcie i zapisanie każdego okna po jego zakończeniu. Mam dużą ilość plików i kończy mi się pamięć RAM przed zakończeniem wykonywania.
Ten komentarz został zminimalizowany przez moderatora na stronie
Tak, po prostu dodaj poniższy kod, jeśli chcesz, aby zapisać plik o tej samej nazwie:

„Zapisywanie skoroszytu”
ActiveWorkbook.Save
Ten komentarz został zminimalizowany przez moderatora na stronie
Witaj Caitlin ,
Być może poniższy kod może ci pomóc, za każdym razem po uruchomieniu konkretnego kodu wyskoczy okienko z prośbą o zapisanie pliku przypominające o zapisaniu skoroszytu.

Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Dim xWB jako skoroszyt
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Wykonaj, gdy xFileName <> ""
Ustaw xWB = Workbooks.Open(xFdItem & xFileName)
Z xWB
„Twój kod tutaj”
Kończyć z
xWB.Zamknij
xNazwaPliku = Katalog
Pętla
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć!

Próbuję wstawić swój kod do twojego i kiedy uruchamiam makro, pojawia się następujący komunikat: Błąd wykonania „429”: ActiveX nie może utworzyć obiektu. Proszę doradzić, jak można to naprawić. Dziękuję Ci!

Mój kod:

Ustaw RInput = Zakres("A2:A21")
Ustaw wyjście = zakres ("D2:D22")

Dim A() jako wariant
ReDim A(1 do RInput.Rows.Count, 0)
A = RWartość wejściowa2

Ustaw d = CreateObject("Scripsting.Dictionary")

Dla i = 1 do UBound(A)
Jeśli d.Istnieje(A(i,1)) Wtedy
d(A(i,1)) = d(A(i,1)) + 1
Więcej
d.Dodaj A(i, 1), 1
End If
Dalej
Dla i = 1 do UBound(A)
A(i, 1) = d(A(i, 1))
Dalej

Wyjście = A
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Z powodzeniem użyłem tego makra do sformatowania plików NBA dla 30 drużyn, każdy z własną książką. Wczoraj otrzymałem komunikat o błędzie, że modułu (makro) nie można uzupełnić, usunąć lub edytować (do zapisania). Uszkodził mój osobisty skoroszyt makr i sprawił, że program Excel praktycznie nie nadaje się do użytku. Wywala aplikację za każdym razem, gdy próbuję uzyskać dostęp do makra z dowolnego pliku. Obsługa programu Excel i obsługa systemu Windows nie były w stanie naprawić rzeczy. Możesz pomóc?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Czy istnieje sposób, w jaki mogę zdefiniować miejsce docelowe pliku w samym skrypcie. Chcę pominąć proces 3, w którym musimy przeglądać konkretny folder.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, dzięki za ten kod. czy możesz mi powiedzieć, jak mogę uzyskać wynik mojego makra, dla którego otworzyłem wszystkie skoroszyty w jednym arkuszu (wynik każdego skoroszytu z rzędu)? i czy istnieje sposób na dodanie nazwy każdego skoroszytu do wiersza z danymi z poprzedniego kroku?
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi

Otrzymałem błąd w czasie wykonywania 1004: składnia nie jest poprawna, gdy uruchomiłem następujący kod, który jest Extend Office VBA, aby „Uruchom makro w wielu skoroszytach z kodem VBA” za pomocą Extend Office VBA „Usuń wszystkie nazwane zakresy z kodem VBA” w gnieździe kodu:

Podrzędne pliki pętli()

Dim xFd jako okno pliku

Dim xFdItem jako wariant

Dim xFileName jako ciąg

Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFd.Show = -1 Wtedy

xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

Wykonaj, gdy xFileName <> ""

With Workbooks.Open (xFdItem & xFileName)

' Sub Usuń nazwy()

„Aktualizacja 20140314”

Dim xNazwa jako nazwa

Dla każdego xName w aplikacji.ActiveWorkbook.Names

xNazwa.Usuń

Dalej


Kończyć z

xNazwaPliku = Katalog

Pętla

End If

End Sub

To, co próbuję zrobić, to uruchomić makro, które usuwa nazwane zakresy w ośmiu skoroszytach znajdujących się w tym samym folderze.

BTW, po raz pierwszy użyłem czegoś z Extend Office i to nie działa. Ta strona była dla mnie niezwykle pomocna.

Sugestie/komentarze byłyby bardzo mile widziane.

aldc
Ten komentarz został zminimalizowany przez moderatora na stronie
Witaj, aldc,
Twój kod działa dobrze w moim skoroszycie, której wersji programu Excel używasz?
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, ten kod jest taki dobry i użyteczny. Często go używam!

Obecnie w mojej organizacji używamy SharePoint do przechowywania naszych plików. Czy istnieje sposób, aby ten kod działał we wszystkich plikach w folderze Sharepoint?
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, dziękuję za ten kod.
Czy istnieje również sposób na przechodzenie przez podfoldery? Powiedzmy, że mam jeden folder, aw nim dziesięć innych folderów, z których każdy zawiera plik Excela.

Czy istnieje sposób, aby po prostu wybrać folder podstawowy, aby kod przechodził przez wszystkie jego podfoldery?

Dziękuję Ci.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Darko,Aby uruchomić kod z folderu z podfolderami, zastosuj następujący kod: Sub LoopThroughFiles_Subfolders(xStrPath As String)
Dim xFolderName
Dim xNazwaPliku
Dim xArrSFath() jako ciąg
Dim xI jako liczba całkowita
Jeśli xStrPath = "" Następnie wyjdź z Sub
xFileName = Dir(xStrPath & "*.xls*")
Wykonaj, gdy xFileName <> ""
Z Workbooks.Open(xStrPath i xFileName)
„Twój kod tutaj”
Kończyć z
xNazwaPliku = Katalog
Pętla
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFath(0)
Zrób, gdy xFolderName <> ""
Jeśli xSFolderName <> "." I xSFolderName <> „..” Wtedy
If (GetAttr(xStrPath & xSFolderName) i vbDirectory) = vbDirectory Then
xI = xI + 1
ReDim Zachowaj xArrSFath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
End If
End If
xFolderName = Dir
Pętla
Jeśli UBound(xArrSFath) > 0 Wtedy
Dla xI = 0 To UBound(xArrSFath)
LoopThroughFiles_Subfolders (xArrSFath(xI))
Następny xI
End If
End Sub
Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
End If
Koniec SubProszę spróbować, mam nadzieję, że może ci to pomóc!
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy oprócz powyższego kodu można otwierać pliki Excela w kolejności chronologicznej, którą chciałem?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć przede wszystkim wielkie dzięki za makro, z którym jest naprawdę przydatne. Zastanawiałem się tylko, czy mamy sposób na odświeżenie folderu w onedrive za pomocą makra. Jeśli tak, czy mógłbyś mi powiedzieć, co mogę tutaj zrobić, aby odświeżyć pliki w onedrive za pomocą skryptu makr?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, bardzo dziękuję za ten skrypt, działa mi bardzo dobrze, ale mam specjalne potrzeby : Czy istnieje sposób na zmianę skryptu, aby zastosował mój kod z warunkami nazwy pliku ORAZ w podfolderach?
Wyjaśniam: jestem nauczycielem i stworzyłem rozwiązanie Excela, aby zapisywać wyniki uczniów i umożliwić nauczycielom konsultowanie się z nimi. Aby to zrobić, mam plik na temat szkoły i jeden dla odpowiedzialnej klasy, wszystko w folderze na klasę.
Więc kiedy znajdę błąd lub optymalizację, muszę zgłosić zmiany we wszystkich plikach we wszystkich podfolderach.
Ale ponieważ wszystkie pliki nie są takie same (inna organizacja tematów), chciałbym zastosować mój przykład kodu do wszystkich plików o nazwie „klasa matematyczna” we wszystkich podfolderach lub przeciwnie, zastosować mój kod do wszystkich plików w podfolderach z wyjątkiem wszystkich plików o nazwie „xyz”. Dzięki !Fabrice
Ten komentarz został zminimalizowany przez moderatora na stronie
Twój podany kod nie działa z następującym VBA, czy możesz pomóc Sub Bundles()

Dim vWS jako arkusz roboczy
przyciemnione vA, vA2()
Dim vR tak długo, vSum tak długo, vC tak długo
Dim vN tak długo, vN2 tak długo, vN3 tak długo

Ustaw vWS = Aktywny arkusz
Z vWS
vR = .Komórki(Wiersze.Liczba, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" i vR))
Redim Zachowaj vA2 (1 do vSum, 1 do 4)
vA = .Range("A2:D" i vR)
Dla vN = 1 Do vR - 1
Dla vN2 = 1 do vA(vN, 4)
vC = vC + 1
Dla vN3 = 1 do 4
vA2(vC, vN3) = vA(vN, vN3)
Następny vN3
Następny vN2
Następny vN
Kończyć z
vC = 1
Dla vN = 1 Do vSum - 2
vA2(vN, 4) = vC
Jeśli vA2(vN + 1, 2) = vA2(vN, 2) Wtedy
vC = vC + 1
vA2(vN + 1, 4) = vC
Więcej
vA2(vN + 1, 4) = 1
vC = 1
End If
Następny vN
Application.ScreenUpdating = Fałsz
Arkusze.Dodaj
Z ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1)).Resize(vSum, 4) = vA2
Kończyć z
Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Chcę uruchomić ten VBA w wielu arkuszach w folderze naraz, czy możesz pomóc Sub Bundles()

Dim vWS jako arkusz roboczy
przyciemnione vA, vA2()
Dim vR tak długo, vSum tak długo, vC tak długo
Dim vN tak długo, vN2 tak długo, vN3 tak długo

Ustaw vWS = Aktywny arkusz
Z vWS
vR = .Komórki(Wiersze.Liczba, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" i vR))
Redim Zachowaj vA2 (1 do vSum, 1 do 4)
vA = .Range("A2:D" i vR)
Dla vN = 1 Do vR - 1
Dla vN2 = 1 do vA(vN, 4)
vC = vC + 1
Dla vN3 = 1 do 4
vA2(vC, vN3) = vA(vN, vN3)
Następny vN3
Następny vN2
Następny vN
Kończyć z
vC = 1
Dla vN = 1 Do vSum - 2
vA2(vN, 4) = vC
Jeśli vA2(vN + 1, 2) = vA2(vN, 2) Wtedy
vC = vC + 1
vA2(vN + 1, 4) = vC
Więcej
vA2(vN + 1, 4) = 1
vC = 1
End If
Następny vN
Application.ScreenUpdating = Fałsz
Arkusze.Dodaj
Z ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1)).Resize(vSum, 4) = vA2
Kończyć z
Application.ScreenUpdating = True

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Próbowałem uruchomić kod, ale w wierszu „With Workbooks.Open(xFdItem & xFileName)” pojawia się błąd „424: Object Required”. Patrząc głębiej, okazuje się, że skoroszyty programu Excel przechowywane w interesującym folderze nie są wyświetlane/istnieją (gdy okno otwierane z wyświetlaniem kodu, jeśli spróbuję otworzyć folder, a nie go wybrać, jest ono puste). Jak to?
Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Wykonaj, gdy xFileName <> ""
With Workbooks.Open (xFdItem & xFileName)
Arkusze.Dodaj po:=Aktywny arkusz
Arkusze("Arkusz2").Wybierz
Arkusze("Arkusz2").Name = "Główny"
Arkusze("Master").Wybierz
Arkusze("Master").Przenieś do:=Arkusze(1)
Kończyć z
xNazwaPliku = Katalog
Pętla
End If
End Sub


Czy możesz mi pomóc rozwiązać ten problem?
Ten komentarz został zminimalizowany przez moderatora na stronie
To moja ulubiona strona internetowa z absolutnie przejrzystymi instrukcjami (bardziej niż jakikolwiek film na YouTube) i wciąż do niej wracam. Dziękuję bardzo za te tutoriale - jesteś ratownikiem smutnego studenta.
Ten komentarz został zminimalizowany przez moderatora na stronie
Podrzędne pliki pętli()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Wykonaj, gdy xFileName <> ""
With Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Zaznaczenie.Wstaw przesunięcie:=xlToRight
AktywnaKomórka.Wybierz
Kończyć z
xNazwaPliku = Katalog
Pętla
End If
Koniec Sub, proszę o pomoc . BTW, moje rozszerzenie plików programu Excel to (.csv - "rozdzielone przecinkami") . i mam 500 plików excela w folderze ze średnią liczbą wierszy około 500000 .. Proszę o pomoc . Chcę tylko wstawić kolumnę w każdym skoroszycie
Ten komentarz został zminimalizowany przez moderatora na stronie
czy kiedykolwiek otrzymałeś odpowiedź na swoje pytanie? Próbuję zrobić to samo z ponad 3700 plikami csv. Wystarczy dodać 1 kolumnę (A).
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, potrzebujący i Carly, Aby rozwiązać swój problem, aby uruchomić kod dla wielu plików CSV, wystarczy zmienić rozszerzenie pliku .xls na .csv, jak pokazano poniżej: Podrzędne pliki pętli ()
Dim xFd jako okno pliku
Dim xFdItem jako wariant
Dim xFileName jako ciąg
Ustaw xFd = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFd.Show = -1 Wtedy
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Wykonaj, gdy xFileName <> ""
With Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Zaznaczenie.Wstaw przesunięcie:=xlToRight
AktywnaKomórka.Wybierz
Kończyć z
xNazwaPliku = Katalog
Pętla
End If
Koniec SubProszę spróbować, mam nadzieję, że może ci to pomóc!
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, czy można uruchomić makro tylko w arkuszach różnych skoroszytów o określonej nazwie? Dziękuję!!
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Sara,
Przepraszamy, nie ma dobrego rozwiązania zgłoszonego problemu.
Dziękuję Ci!
Nie ma tu jeszcze żadnych komentarzy
Pokaż więcej
Zostaw swój komentarz
Publikowanie jako gość
×
Oceń ten post:
0   Postacie
Sugerowane lokalizacje

Bądż na bieżąco

Prawa autorskie © 2009 - www.extendoffice.com. | Wszelkie prawa zastrzeżone. Zasilany przez ExtendOffice, | Mapa strony
Microsoft i logo Office są znakami towarowymi lub zastrzeżonymi znakami towarowymi Microsoft Corporation w Stanach Zjednoczonych i / lub innych krajach.
Chronione przez Sectigo SSL