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

Cum se execută o macrocomandă în același timp pe mai multe fișiere din registrul de lucru?

În acest articol, voi vorbi despre cum să rulați o macro pe mai multe fișiere din registrul de lucru în același timp, fără a le deschide. Următoarea metodă vă poate ajuta să rezolvați această sarcină în Excel.

Rulați o macrocomandă la fel în mai multe registre de lucru cu cod VBA


Rulați o macrocomandă la fel în mai multe registre de lucru cu cod VBA

Pentru a rula o macro pe mai multe registre de lucru fără a le deschide, vă rugăm să aplicați următorul cod VBA:

1. Țineți apăsat butonul ALT + F11 tastele pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următoarea macro în fișierul Module Fereastră.

Cod VBA: Rulați aceeași macro pe mai multe registre de lucru în același timp:

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

notițe: În codul de mai sus, vă rugăm să copiați și să lipiți propriul cod fără Sub îndreptare și End Sub subsol între Cu Workbooks.Open (xFdItem & xFileName) și Se termina cu scripturi. Vedeți captura de ecran:

doc rulează macrocomenzi 1

3. Apoi apăsați F5 tasta pentru a executa acest cod și a Naviga fereastra este afișată, selectați un folder care conține registrele de lucru pe care doriți să le aplicați tuturor acestei macrocomenzi, consultați captura de ecran:

doc rulează macrocomenzi 2

4. Apoi faceți clic pe OK butonul, macrocomanda dorită va fi executată simultan de la un registru de lucru la altele.

 


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab

 

Comentarii (43)
Evaluat 4.5 din 5 · evaluări 1
Acest comentariu a fost redus la minimum de moderatorul de pe site
Macrocomandă foarte utilă și funcționează bine, dar aș dori să pot selecta pe ce fișiere din acel folder vreau să ruleze macrocomanda? Fișierele nu sunt generate automat într-un folder separat și trebuie să rulez macrocomenzi diferite pe fiecare set de fișiere din acel folder și apoi să le mut înapoi în folderul inițial.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am urmat instrucțiunile, dar am primit o eroare de compilare „Loop wihtout Do”. Ce îmi lipsește? Codul meu macro este foarte simplu, doar schimbați dimensiunea fontului rândurilor specificate. Funcționează de la sine. Iată ce am... vă rog ajutați-vă

Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & „*.xls*”)
Faceți în timp ce xFileName <> ""
Cu Workbooks.Open (xFdItem & xFileName)
'Codul tău aici
Rânduri ("2:8").Selectați
Cu Selectie.Font
.Nume = „Arial”
.Dimensiune = 12
.Strikethrough = Fals
.Superscript = Fals
.Indice = Fals
.OutlineFont = Fals
.Umbra = Fals
.Underline = xlUnderlineStyleNone
.Culoare = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Se termina cu
xFileName = Dir
Buclă
Final, dacă
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, yarto,
Ați ratat scriptul „Încheiați cu” de la sfârșitul codului dvs., cel corect ar trebui să fie acesta:
Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & „*.xls*”)
Faceți în timp ce xFileName <> ""
Cu Workbooks.Open (xFdItem & xFileName)
'Codul tău aici
Rânduri ("2:8").Selectați
Cu Selectie.Font
.Nume = „Arial”
.Dimensiune = 16
.Strikethrough = Fals
.Superscript = Fals
.Indice = Fals
.OutlineFont = Fals
.Umbra = Fals
.Underline = xlUnderlineStyleNone
.Culoare = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Se termina cu
Se termina cu
xFileName = Dir
Buclă
Final, dacă
End Sub

Vă rugăm să încercați, sper că vă poate ajuta!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Macrocomandă foarte utilă și funcționează grozav, dar aș dori să pot selecta pe ce fișiere din acel folder vreau să ruleze macrocomanda? De exemplu, am 4 fișiere într-un folder cu alte fișiere excel și vreau să ruleze doar pe acele 4 fișiere specifice. Cum pot să-ți modific macrocomanda pentru a-mi permite să aleg acele 4 fișiere din acel folder?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Joel,
Pentru a declanșa același cod în anumite registre de lucru, ar trebui să aplicați codul de mai jos:

Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Dim xFB ca șir
Cu Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Adevărat
.Filtre.Clear
.Filtre.Adăugați „excel”, „*.xls*”
.Spectacol
Dacă .SelectedItems.Count < 1, apoi Ieșiți din sub
Pentru lngCount = 1 To .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Dacă xFileName <> "" Atunci
Cu Workbooks.Open(Filename:=xFileName)
'Codul tau
Se termina cu
Final, dacă
Următorul lngCount
Se termina cu
End Sub

Vă rugăm să încercați, sper că vă poate ajuta!
Acest comentariu a fost redus la minimum de moderatorul de pe site
multumesc, a fost de mare ajutor
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună!

Încerc să inserez codul meu în al tău și când rulez macro-ul îmi dă următorul mesaj: Eroare de rulare „429”: ActiveX nu poate crea obiectul. Vă rugăm să vă sfătuiți cum poate fi remediat. Mulțumesc!

Codul meu:

Setați RInput = Range("A2:A21")
Set ROutput = Range ("D2:D22")

Dim A() ca variantă
ReDim A(1 la RInput.Rows.Count, 0)
A = RInput.Value2

Set d = CreateObject("Scripting.Dictionary")

Pentru i = 1 La UBound(A)
Dacă d.Există(A(i, 1)) Atunci
d(A(i, 1)) = d(A(i, 1)) + 1
Altfel
d. Adăugați A(i, 1), 1
Final, dacă
Pagina Următoare →
Pentru i = 1 La UBound(A)
A(i, 1) = d(A(i, 1))
Pagina Următoare →

Ieșire = A
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, în primul rând vă mulțumesc pentru această macrocomandă, era exact ceea ce căutam. Totuși, am o problemă, există o modalitate de a închide și de a salva fiecare fereastră pe măsură ce se termină. Am o cantitate mare de fișiere și am rămas fără memorie RAM înainte ca execuția să se încheie.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Da, adăugați mai jos următorul cod dacă doriți să salveze fișierul cu același nume:

— Salvarea registrului de lucru
ActiveWorkbook.Salvare
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Caitlin,
Poate că codul de mai jos vă poate ajuta, de fiecare dată după rularea codului dvs. specific, va apărea o casetă de solicitare pentru salvarea fișierului care vă va reaminti să salvați registrul de lucru.

Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Dim xWB ca registru de lucru
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & „*.xls*”)
La data de eroare CV următoare
Faceți în timp ce xFileName <> ""
Set xWB = Workbooks.Open(xFdItem & xFileName)
Cu xWB
'Codul tău aici
Se termina cu
xWB.Închidere
xFileName = Dir
Buclă
Final, dacă
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună!

Încerc să inserez codul meu în al tău și când rulez macro-ul îmi dă următorul mesaj: Eroare de rulare „429”: ActiveX nu poate crea obiectul. Vă rugăm să vă sfătuiți cum poate fi remediat. Mulțumesc!

Codul meu:

Setați RInput = Range("A2:A21")
Set ROutput = Range ("D2:D22")

Dim A() ca variantă
ReDim A(1 la RInput.Rows.Count, 0)
A = RInput.Value2

Set d = CreateObject("Scripting.Dictionary")

Pentru i = 1 La UBound(A)
Dacă d.Există(A(i, 1)) Atunci
d(A(i, 1)) = d(A(i, 1)) + 1
Altfel
d. Adăugați A(i, 1), 1
Final, dacă
Pagina Următoare →
Pentru i = 1 La UBound(A)
A(i, 1) = d(A(i, 1))
Pagina Următoare →

Ieșire = A
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,

Am folosit această macrocomandă cu succes pentru a formata fișiere NBA pentru cele 30 de echipe, fiecare cu propria carte. Ieri, am primit un mesaj de eroare și că Modulul (macro) nu poate fi completat, șters sau editat (pentru a fi salvat). Mi-a corupt registrul de lucru cu macrocomenzi și a făcut Excel practic inutilizabil pentru mine. Se blochează aplicația de fiecare dată când încerc să accesez o macrocomandă din orice fișier. Suportul Excel și suportul Windows nu au fost capabili să repare lucrurile. Poți să ajuți?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Există vreo modalitate prin care pot defini destinația fișierului în scriptul în sine. Vreau să sărim peste procesul 3 în care trebuie să răsfoim folderul specific.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, mulțumesc pentru acest cod. Vă rog, puteți să-mi spuneți cum pot avea rezultatul macrocomenzii mele pentru care am deschis toate registrele de lucru într-o singură foaie (rezultatul fiecărui registru de lucru la rând)? și există o modalitate de a adăuga numele fiecărui registru de lucru la rândul cu datele de la pasul anterior?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi

Am primit o eroare de execuție 1004: sintaxa nu este corectă când am rulat următorul cod, care este Extend Office VBA pentru a „Rulați o macrocomandă în același timp în mai multe registre de lucru cu cod VBA” cu Extend Office VBA „Ștergeți toate intervalele denumite cu cod VBA" în slotul de introducere a codului:

Sub LoopThroughFiles()

Dim xFd ca FileDialog

Dim xFdItem ca variantă

Dim xFileName ca șir

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

Dacă xFd.Show = -1 Atunci

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

xFileName = Dir(xFdItem & „*.xls*”)

Faceți în timp ce xFileName <> ""

Cu Workbooks.Open (xFdItem & xFileName)

' Sub DeleteNames()

„Actualizare 20140314

Dim xName ca nume

Pentru fiecare xName din Application.ActiveWorkbook.Names

xNume.Șterge

Pagina Următoare →


Se termina cu

xFileName = Dir

Buclă

Final, dacă

End Sub

Ceea ce încerc să fac este să rulez o macrocomandă care șterge intervalele numite din opt registre de lucru care sunt conținute în același folder.

BTW, este prima dată când folosesc ceva de la Extend Office și nu a funcționat. Acest site mi-a fost extrem de util.

Sugestiile/comentariile ar fi foarte apreciate.

aldc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, aldc,
Codul tău funcționează bine în registrul meu de lucru, ce versiune Excel folosești?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, acest cod este atât de bun și util. Il folosesc mult!

În zilele noastre, în organizația mea, acum folosim SharePoint pentru a ne stoca fișierele. Există vreo modalitate de a face acest cod să funcționeze în toate fișierele dintr-un folder sharepoint?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, mulțumesc pentru acest cod.
Există o modalitate de a parcurge și sub-dosarele? Să presupunem că am un folder și în cadrul folderului încă zece foldere, fiecare conținând un fișier Excel.

Există o modalitate de a selecta folderul principal, astfel încât codul să ruleze prin toate subfolderele sale?

Mulțumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, Darko, Pentru a rula un cod dintr-un folder cu subfolderele, vă rugăm să aplicați următorul cod: Sub LoopThroughFiles_Subfolders(xStrPath ca șir)
Dim xSFolderName
Dim xFileName
Dim xArrSFPath() ca șir
Dim xI ca întreg
Dacă xStrPath = "" Ieșiți din sub
xFileName = Dir(xStrPath & „*.xls*”)
Faceți în timp ce xFileName <> ""
Cu Workbooks.Open(xStrPath & xFileName)
'Codul tău aici
Se termina cu
xFileName = Dir
Buclă
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
Faceți în timp ce xSFolderName <> ""
Dacă xSFolderName <> "." Și xSFolderName <> „..” Apoi
Dacă (GetAttr(xStrPath & xSFolderName) și vbDirectory) = vbDirectory Atunci
xI = xI + 1
ReDim Preserve xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & „\”
Final, dacă
Final, dacă
xSFolderName = Dir
Buclă
Dacă UBound(xArrSFPath) > 0, atunci
Pentru xI = 0 La UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Următorul xI
Final, dacă
End Sub
Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
Final, dacă
Încheiați SubVă rugăm să încercați, sper că vă poate ajuta!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Pe lângă codul de mai sus, este posibil să deschid fișierele Excel într-o ordine cronologică pe care mi-am dorit-o?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, în primul rând, mulțumesc pentru macro-ul cu care este foarte util să lucrezi. Mă întrebam doar dacă avem o modalitate de a reîmprospăta folderul din onedrive prin macro. Dacă da, vă rog să-mi spuneți ce pot face aici pentru a reîmprospăta fișierele din onedrive folosind scriptul macro?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, mulțumesc mult pentru acest script, funcționează foarte bine pentru mine, dar am nevoi speciale: Există o modalitate de a schimba scriptul pentru a-mi aplica codul cu condițiile numelui de fișier ȘI în subfoldere?
Explic: Sunt profesor și am creat o soluție excel pentru a salva rezultatele elevilor și pentru a le permite profesorilor să le consulte. Pentru a face acest lucru, am un fișier pe disciplină școlară și unul pentru clasa responsabilă, toate într-un folder pe clasă.
Deci, când găsesc o eroare sau o optimizare, trebuie să raportez modificările din toate fișierele din toate subfolderele.
Dar, deoarece toate fișierele nu sunt la fel (organizație diferită de subiecte), aș dori o modalitate de a aplica codul meu, de exemplu, la toate fișierele numite „clasa de matematică” din toate subfolderele sau, dimpotrivă, să aplic codul meu la toate fișierele în subfoldere, cu excepția tuturor fișierelor numite „xyz”. Mulțumesc !Fabrice
Acest comentariu a fost redus la minimum de moderatorul de pe site
Codul dvs. dat nu funcționează cu următorul VBA. Vă rugăm să ajutați Sub Bundles()

Dim vWS As Worksheet
Dim vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Setați vWS = ActiveSheet
Cu vWS
vR = .Cells(Rânduri.Număr, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" și vR))
ReDim Preserve vA2(1 la vSum, 1 la 4)
vA = .Range(„A2:D” și vR)
Pentru vN = 1 La vR - 1
Pentru vN2 = 1 La vA(vN, 4)
vC = vC + 1
Pentru vN3 = 1 până la 4
vA2(vC, vN3) = vA(vN, vN3)
Următorul vN3
Următorul vN2
Următorul vN
Se termina cu
vC = 1
Pentru vN = 1 La vSum - 2
vA2(vN, 4) = vC
Dacă vA2(vN + 1, 2) = vA2(vN, 2) atunci
vC = vC + 1
vA2(vN + 1, 4) = vC
Altfel
vA2(vN + 1, 4) = 1
vC = 1
Final, dacă
Următorul vN
Application.ScreenUpdating = Fals
Foi.Adăugați
Cu ActiveSheet
vWS.Range(„A1:D1”).Copiați .Range(„A1:D1”)
.Celele(2, 1).Resize(vSum, 4) = vA2
Se termina cu
Application.ScreenUpdating = Adevărat

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Vreau să rulez acest VBA în mai multe foi dintr-un dosar simultan.

Dim vWS As Worksheet
Dim vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Setați vWS = ActiveSheet
Cu vWS
vR = .Cells(Rânduri.Număr, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" și vR))
ReDim Preserve vA2(1 la vSum, 1 la 4)
vA = .Range(„A2:D” și vR)
Pentru vN = 1 La vR - 1
Pentru vN2 = 1 La vA(vN, 4)
vC = vC + 1
Pentru vN3 = 1 până la 4
vA2(vC, vN3) = vA(vN, vN3)
Următorul vN3
Următorul vN2
Următorul vN
Se termina cu
vC = 1
Pentru vN = 1 La vSum - 2
vA2(vN, 4) = vC
Dacă vA2(vN + 1, 2) = vA2(vN, 2) atunci
vC = vC + 1
vA2(vN + 1, 4) = vC
Altfel
vA2(vN + 1, 4) = 1
vC = 1
Final, dacă
Următorul vN
Application.ScreenUpdating = Fals
Foi.Adăugați
Cu ActiveSheet
vWS.Range(„A1:D1”).Copiați .Range(„A1:D1”)
.Celele(2, 1).Resize(vSum, 4) = vA2
Se termina cu
Application.ScreenUpdating = Adevărat

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am încercat să rulez codul, dar eroarea „424: Object Required” apare la linia „With Workbooks.Open(xFdItem & xFileName)”. Privind mai în profunzime, se pare că cărțile de lucru excels stocate în folderul de interes nu se afișează/există (Când s-a deschis fereastra cu afișajul de cod, dacă încerc să deschid folderul și nu să-l selectez, acesta este gol). Cum așa?
Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & „*.xls*”)
Faceți în timp ce xFileName <> ""
Cu Workbooks.Open (xFdItem & xFileName)
Sheets.Add After:=ActiveSheet
Sheets(„Sheet2”).Selectați
Sheets("Sheet2").Name = "Master"
Sheets(„Master”).Selectați
Sheets(„Master”).Move Before:=Foi de calcul(1)
Se termina cu
xFileName = Dir
Buclă
Final, dacă
End Sub


Ma puteti ajuta va rog sa rezolv aceasta problema?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Acesta este site-ul meu preferat cu cele mai clare instrucțiuni (mai mult decât orice videoclip de pe YouTube) și revin mereu la el. Vă mulțumesc foarte mult pentru aceste tutoriale - sunteți salvatorul trist al unui student absolvent.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & „*.xls*”)
Faceți în timp ce xFileName <> ""
Cu Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Se termina cu
xFileName = Dir
Buclă
Final, dacă
End Sub, vă rugăm să ajutați. BTW, extensia mea de fișiere Excel este (.csv - „delimitat prin virgulă”). și am 500 de fișiere Excel într-un folder cu o medie de fiecare rând de aproximativ 500000 de rânduri .. Vă rugăm să ajutați . Vreau doar să inserez o coloană în fiecare registru de lucru
Acest comentariu a fost redus la minimum de moderatorul de pe site
ai primit vreodata un raspuns la intrebarea ta? Încerc să fac același lucru cu peste 3700 de fișiere csv. Trebuie doar să adaug o coloană (A).
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, nevoiași și Carly, Pentru a vă rezolva problema, pentru a rula codul pentru mai multe fișiere CSV, trebuie doar să schimbați extensia de fișier .xls la .csv, așa cum se arată mai jos: Sub LoopThroughFiles()
Dim xFd ca FileDialog
Dim xFdItem ca variantă
Dim xFileName ca șir
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Dacă xFd.Show = -1 Atunci
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & „*.csv*”)
Faceți în timp ce xFileName <> ""
Cu Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Se termina cu
xFileName = Dir
Buclă
Final, dacă
Încheiați SubVă rugăm să încercați, sper că vă poate ajuta!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, este posibil să rulați macro-ul numai în foile diferitelor cărți de lucru cu un nume specific? Mulțumiri!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut, Sara,
Ne pare rău, nu există o soluție bună la problema pe care ați ridicat-o.
Mulțumesc!
Nu există comentarii postate aici încă
Încărcați mai
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL