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

Hogyan lehet egy makrót egyszerre futtatni több munkafüzetfájlban?

Ebben a cikkben arról fogok beszélni, hogyan lehet egy makrót több munkafüzetfájlon egyszerre futtatni anélkül, hogy megnyitnánk őket. A következő módszer segíthet ennek a feladatnak az Excelben történő megoldásában.

Futtasson makrót egyidejűleg több VBA-kódú munkafüzeten


Futtasson makrót egyidejűleg több VBA-kódú munkafüzeten

Ha makrót szeretne futtatni több munkafüzeten anélkül, hogy megnyitná őket, kérjük, alkalmazza a következő VBA-kódot:

1. Tartsa lenyomva a ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Kattints betétlap > Modulok, és illessze be a következő makrót a Modulok Ablak.

VBA-kód: Futtassa ugyanazt a makrót több munkafüzeten egyszerre:

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

Megjegyzések: A fenti kódba másolja és illessze be saját kódját a alatt címsor és End Sub lábléc a Munkafüzetekkel. Nyissa meg (xFdItem & xFileName) és a Vége szkriptek. Lásd a képernyőképet:

doc futtassa a makró több fájlt 1

3. Ezután nyomja meg a gombot F5 kulcs a kód végrehajtásához, és a Tallózás ablak megjelenik, kérjük, válasszon egy mappát, amely tartalmazza azokat a munkafüzeteket, amelyekkel ezt a makrót alkalmazni szeretné, lásd a képernyőképet:

doc futtassa a makró több fájlt 2

4. Kattintson a gombra OK gombra kattintva a kívánt makró egyszerre végrehajtásra kerül egyik munkafüzetből a másikba.

 


A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja

 

A megjegyzések rendezése szerint
Hozzászólások (43)
Az 4.5-t az 5-ből kiértékelte · 1 értékelés
A weboldal moderátora ezt a megjegyzést minimalizálta
Nagyon hasznos makró, és jól működik, de szeretném kiválasztani, hogy abból a mappából mely fájlokon szeretném futtatni a makrót? A fájlok nem jönnek létre automatikusan egy külön mappában, és különböző makrókat kell futtatnom az adott mappából származó minden egyes fájlkészleten, majd vissza kell helyeznem őket a kezdeti mappába.
A weboldal moderátora ezt a megjegyzést minimalizálta
Követtem az utasításokat, de fordítási hibaüzenetet kapok: "Loop wihtout Do". mit hiányolok? A makrókódom nagyon egyszerű, csak módosítsa a megadott sorok betűméretét. Magától működik. Íme, amim van... kérlek segíts

Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Tegye az xFileName <> "" közben
Munkafüzetekkel. Nyissa meg (xFdItem & xFileName)
'itt a kódod
Sorok("2:8"). Válassza a lehetőséget
A Selection.Font funkcióval
.Name = "Arial"
.Méret = 12
.Áthúzott = Hamis
.Superscript = Hamis
.Subscript = Hamis
.OutlineFont = Hamis
.Shadow = Hamis
.Aláhúzás = xlUnderlineStyleNone
.Szín = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Vége
xFileName = Dir
Hurok
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Yarto!
Kihagyta az „End with” szkriptet a kód végén, a helyesnek a következőnek kell lennie:
Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Tegye az xFileName <> "" közben
Munkafüzetekkel. Nyissa meg (xFdItem & xFileName)
'itt a kódod
Sorok("2:8"). Válassza a lehetőséget
A Selection.Font funkcióval
.Name = "Arial"
.Méret = 16
.Áthúzott = Hamis
.Superscript = Hamis
.Subscript = Hamis
.OutlineFont = Hamis
.Shadow = Hamis
.Aláhúzás = xlUnderlineStyleNone
.Szín = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Vége
Vége
xFileName = Dir
Hurok
Ha véget
End Sub

Próbáld ki, remélem tud segíteni!
A weboldal moderátora ezt a megjegyzést minimalizálta
Nagyon hasznos makró, és remekül működik, de szeretném kiválasztani, hogy abból a mappából mely fájlokon szeretném futtatni a makrót? Például 4 fájl van egy mappában más excel fájlokkal, és csak azon a 4 fájlon szeretném futtatni. Hogyan módosíthatom a makrót, hogy kiválasszam azt a 4 fájlt a mappából?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Joel,
Ha ugyanazt a kódot szeretné aktiválni bizonyos munkafüzetekben, akkor az alábbi kódot kell alkalmaznia:

Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xFB As String
Az Application.FileDialog(msoFileDialogOpen) segítségével
.AllowMultiSelect = Igaz
.Szűrők.Tiszta
.Filters.Add "excel", "*.xls*"
.Előadás
Ha .SelectedItems.Count < 1, akkor lépjen ki a Sub-ból
For lngCount = 1 - .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Ha xFileName <> "" Akkor
Munkafüzetekkel.Open(Fájlnév:=xFájlnév)
'a kódod
Vége
Ha véget
Következő lngCount
Vége
End Sub

Próbáld ki, remélem tud segíteni!
A weboldal moderátora ezt a megjegyzést minimalizálta
köszi, igazán hasznos volt
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi!

Megpróbálom beilleszteni a kódomat a tiédbe, és amikor futtatom a makrót, a következő üzenetet kapom: Futásidejű hiba '429': Az ActiveX nem tudja létrehozni az objektumot. Kérem adjon tanácsot, hogyan lehetne javítani. Köszönöm!

Az én kódom:

RInput = Tartomány beállítása ("A2:A21")
ROkimenet beállítása = Tartomány("D2:D22")

Dim A() Változatként
Redim A(1-től RInput.Rows.Count, 0)
A = RInput.Value2

Set d = CreateObject("Scripsting.Dictionary")

Ha i = 1 - UBound(A)
Ha d.Exists(A(i, 1)) Akkor
d(A(i, 1)) = d(A(i, 1)) + 1
Más
d. Adja hozzá az A(i, 1), 1
Ha véget
Következő
Ha i = 1 - UBound(A)
A(i, 1) = d(A(i, 1))
Következő

ROkimenet = A
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, először is köszönöm ezt a makrót, pontosan ezt kerestem. Van azonban egy problémám: van-e mód az egyes ablakok bezárására és mentésére, amikor befejeződik. Nagy mennyiségű fájlom van, és a végrehajtás befejezése előtt kifogy a RAM.
A weboldal moderátora ezt a megjegyzést minimalizálta
Igen, csak adja hozzá az alábbi kódot, ha ugyanazzal a névvel szeretné menteni a fájlt:

'A munkafüzet mentése
ActiveWorkbook.Save
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Caitlin!
Talán az alábbi kód segíthet Önnek, amikor az adott kód futtatása után minden alkalommal megjelenik egy mentési fájl ablak, amely emlékezteti a munkafüzet mentésére.

Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Dim xWB munkafüzetként
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Tegye az xFileName <> "" közben
Set xWB = Workbooks.Open(xFdItem & xFileName)
xWB-vel
'itt a kódod
Vége
xWB.Close
xFileName = Dir
Hurok
Ha véget
End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi!

Megpróbálom beilleszteni a kódomat a tiédbe, és amikor futtatom a makrót, a következő üzenetet kapom: Futásidejű hiba '429': Az ActiveX nem tudja létrehozni az objektumot. Kérem adjon tanácsot, hogyan lehetne javítani. Köszönöm!

Az én kódom:

RInput = Tartomány beállítása ("A2:A21")
ROkimenet beállítása = Tartomány("D2:D22")

Dim A() Változatként
Redim A(1-től RInput.Rows.Count, 0)
A = RInput.Value2

Set d = CreateObject("Scripsting.Dictionary")

Ha i = 1 - UBound(A)
Ha d.Exists(A(i, 1)) Akkor
d(A(i, 1)) = d(A(i, 1)) + 1
Más
d. Adja hozzá az A(i, 1), 1
Ha véget
Következő
Ha i = 1 - UBound(A)
A(i, 1) = d(A(i, 1))
Következő

ROkimenet = A
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló,

Ezt a makrót sikeresen használtam a 30 csapat NBA-fájljainak formázására, mindegyik saját könyvével. Tegnap kaptam egy hibaüzenetet, amely szerint a modul (makró) nem fejezhető be, nem törölhető vagy szerkeszthető (mentendő). Megsértette a személyes makró-munkafüzetemet, és gyakorlatilag használhatatlanná tette az Excelt számomra. Minden alkalommal összeomlik az alkalmazás, amikor megpróbálok elérni egy makrót bármely fájlból. Az Excel támogatás és a Windows támogatás nem tudta javítani a dolgokat. Tud segíteni?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Meg tudom határozni a fájl célját magában a szkriptben? Ki akarom hagyni a 3. folyamatot, ahol az adott mappában kell tallóznunk.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Köszönjük ezt a kódot. meg tudnád mondani, hogyan kaphatom meg a makróm eredményét, amelyhez az összes munkafüzetet megnyitottam egy lapon (minden munkafüzet eredménye sorban)? és van rá mód, hogy az előző lépés adatait tartalmazó sorhoz minden munkafüzet nevét hozzáadjuk?
A weboldal moderátora ezt a megjegyzést minimalizálta
Hi

1004-es futásidejű hibaüzenetet kaptam: a szintaxis nem megfelelő, amikor a következő kódot futtattam, ami az Extend Office VBA a "Makró futtatása egyszerre több munkafüzetben VBA-kóddal" az Extend Office VBA "Minden elnevezett tartomány törlése" parancsával. VBA-kóddal" a kódhely beszúrásával:

Sub LoopThroughFiles()

Dim xFd mint FileDialog

Dim xFdItem As Variant

Dim xFileName As String

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

Ha xFd.Show = -1 Akkor

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

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

Tegye az xFileName <> "" közben

Munkafüzetekkel. Nyissa meg (xFdItem & xFileName)

' Sub DeleteNames()

„Frissítés: 20140314

Dim xName Névként

Minden xName-hez az Application.ActiveWorkbook.Namesben

xName.Delete

Következő


Vége

xFileName = Dir

Hurok

Ha véget

End Sub

Egy olyan makrót próbálok futtatni, amely törli a megnevezett tartományokat nyolc munkafüzetben, amelyek ugyanabban a mappában vannak.

BTW, ez az első alkalom, hogy használtam valamit az Extend Office-ból, és nem működik. Ez a weboldal rendkívül hasznos volt számomra.

Javaslatokat/megjegyzéseket nagyra értékelnénk.

aldc
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia aldc!
A kódja jól működik a munkafüzetemben, melyik Excel verziót használja?
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló, ez a kód nagyon jó és hasznos. sokat használom!

Manapság a szervezetemben a SharePointot használjuk fájljaink tárolására. Van valami mód arra, hogy ez a kód működjön a sharepoint mappában lévő összes fájlon?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Köszönjük ezt a kódot.
Van mód az almappák közötti hurokra is? Tegyük fel, hogy van egy mappám, és azon belül tíz további mappám van, amelyek mindegyike egy-egy excel fájlt tartalmaz.

Van mód arra, hogy egyszerűen kiválassza az elsődleges mappát, hogy a kód végigfusson az összes almappáján?

Köszönöm.
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Darko! Ha egy almappát tartalmazó mappából szeretne kódot futtatni, használja a következő kódot: Sub LoopThroughFiles_Subfolders (xStrPath karakterláncként)
Dim xSFolderName
Dim xFileName
Dim xArrSFPath() karakterláncként
Dim xI Egész számként
Ha xStrPath = "" Akkor lépjen ki a Sub
xFileName = Dir(xStrPath & "*.xls*")
Tegye az xFileName <> "" közben
Workbooks.Open(xStrPath & xFileName) segítségével
'itt a kódod
Vége
xFileName = Dir
Hurok
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
Do While xSFolderName <> ""
Ha xSFolderName <> "." És xSFolderName <> ".." Ezután
If (GetAttr(xStrPath & xSFolderName) és vbDirectory) = vbDirectory then
xI = xI + 1
ReDim Preserve xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
Ha véget
Ha véget
xSFolderName = Dir
Hurok
Ha UBound(xArrSFPath) > 0 Akkor
Ha xI = 0 - UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Következő xI
Ha véget
End Sub
Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
Ha véget
Az alprogram vége Kérjük, próbálja meg, remélem segíthet!
A weboldal moderátora ezt a megjegyzést minimalizálta
A fenti kódon kívül meg lehet nyitni az excel fájlokat olyan időrendi sorrendben, ahogyan szeretném?
A weboldal moderátora ezt a megjegyzést minimalizálta
Sziasztok, köszönöm szépen a makrót, amivel igazán praktikus lehet dolgozni. Csak arra gondoltam, hogy van-e módunk arra, hogy makrón keresztül frissítsük a onedrive mappát. Ha igen, kérem, tudassa velem, mit tehetek itt, hogy frissítsem a onedrive-on lévő fájlokat makró szkript segítségével?
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, köszönöm szépen ezt a szkriptet, nagyon jól működik nekem, de speciális igényeim vannak: Van mód a szkript megváltoztatására, hogy a kódomat a fájlnév feltételekkel ÉS az almappákban alkalmazza?
Elmagyarázom: Tanár vagyok, és létrehoztam egy Excel-megoldást, hogy elmentsem a diákok eredményeit, és lehetővé tegyem a tanárok számára, hogy konzultálhassanak velük. Ehhez van egy fájlom iskolai tantárgyanként és egy a felelős osztály számára, mindezt osztályonként egy mappában.
Tehát ha hibát vagy optimalizálást találok, jelentenem kell a változásokat az összes almappában lévő összes fájlban.
De mivel nem minden fájl egyforma (különböző alanyi szervezetek), szeretnék egy módot arra, hogy a par példa kódomat alkalmazzam az összes almappában lévő "matematika osztály" nevű fájlra, vagy ellenkezőleg, alkalmazzam a kódomat az összes fájlra. almappákban, kivéve az összes "xyz" nevű fájlt. Köszönöm !Fabrice
A weboldal moderátora ezt a megjegyzést minimalizálta
A megadott kód nem működik a következő VBA-val, kérem, segítsenSub Bundles()

Dim vWS munkalapként
Dim vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Állítsa be a vWS = ActiveSheet
vWS-el
vR = .Cells(Rows.Count, 4).End(xlUp).Sor
vSum = Application.Sum(.Tartomány("D2:D" & vR))
ReDim Preserve vA2 (1-től vSum-ig, 1-től 4-ig)
vA = .Tartomány("A2:D" & vR)
Ha vN = 1 - vR - 1
Ha vN2 = 1 - vA(vN, 4)
vC = vC + 1
vN3 esetén = 1–4
vA2(vC, vN3) = vA(vN, vN3)
Következő vN3
Következő vN2
Következő vN
Vége
vC = 1
Ha vN = 1 - vSum - 2
vA2(vN, 4) = vC
Ha vA2(vN + 1, 2) = vA2(vN, 2) Akkor
vC = vC + 1
vA2(vN + 1, 4) = vC
Más
vA2(vN + 1, 4) = 1
vC = 1
Ha véget
Következő vN
Application.ScreenUpdating = Hamis
Lapok.Hozzáadás
Az ActiveSheet programmal
vWS.Range("A1:D1"). .Tartomány másolása("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
Vége
Application.ScreenUpdating = Igaz

End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Egyszerre több munkalapon szeretném futtatni ezt a VBA-t egy mappában, kérem, segítsenSub Bundles()

Dim vWS munkalapként
Dim vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Állítsa be a vWS = ActiveSheet
vWS-el
vR = .Cells(Rows.Count, 4).End(xlUp).Sor
vSum = Application.Sum(.Tartomány("D2:D" & vR))
ReDim Preserve vA2 (1-től vSum-ig, 1-től 4-ig)
vA = .Tartomány("A2:D" & vR)
Ha vN = 1 - vR - 1
Ha vN2 = 1 - vA(vN, 4)
vC = vC + 1
vN3 esetén = 1–4
vA2(vC, vN3) = vA(vN, vN3)
Következő vN3
Következő vN2
Következő vN
Vége
vC = 1
Ha vN = 1 - vSum - 2
vA2(vN, 4) = vC
Ha vA2(vN + 1, 2) = vA2(vN, 2) Akkor
vC = vC + 1
vA2(vN + 1, 4) = vC
Más
vA2(vN + 1, 4) = 1
vC = 1
Ha véget
Következő vN
Application.ScreenUpdating = Hamis
Lapok.Hozzáadás
Az ActiveSheet programmal
vWS.Range("A1:D1"). .Tartomány másolása("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
Vége
Application.ScreenUpdating = Igaz

End Sub
A weboldal moderátora ezt a megjegyzést minimalizálta
Megpróbáltam futtatni a kódot, de a "424 : Object Required" hiba jelenik meg a "With Workbooks.Open(xFdItem & xFileName)" sorban. Ha mélyebben nézünk, az látszik, hogy az érdeklődési körbe tartozó mappában tárolt excels munkafüzetek nem jelennek meg/léteznek (A kódmegjelenítéssel megnyíló ablaknál, ha megpróbálom megnyitni a mappát és nem kijelölni, üres). Hogy hogy?
Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Tegye az xFileName <> "" közben
Munkafüzetekkel. Nyissa meg (xFdItem & xFileName)
Sheets.Add After:=ActiveSheet
Lapok("2. lap"). Válassza a lehetőséget
Sheets("Sheet2").Név = "Mester"
Lapok ("Master"). Válassza ki
Sheets("Master").Move Before:=Sheets(1)
Vége
xFileName = Dir
Hurok
Ha véget
End Sub


Kérem, segítsen megoldani ezt a problémát?
A weboldal moderátora ezt a megjegyzést minimalizálta
Ez a kedvenc webhelyem a legvilágosabb utasításokkal (inkább, mint bármely YouTube-videó), és újra és újra visszatérek rá. Nagyon köszönöm ezeket az oktatóanyagokat – Ön egy szomorú végzős diák életmentője.
A weboldal moderátora ezt a megjegyzést minimalizálta
Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Tegye az xFileName <> "" közben
Munkafüzetekkel. Nyissa meg (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Oszlopok("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Vége
xFileName = Dir
Hurok
Ha véget
End Sub, kérlek segíts. BTW, az excel fájl kiterjesztésem (.csv - "vesszővel tagolt") . és 500 excel fájl van egy mappában, minden sor átlagosan körülbelül 500000 XNUMX sorszámmal. Kérem, segítsen. Csak oszlopot szeretnék beszúrni minden munkafüzetbe
A weboldal moderátora ezt a megjegyzést minimalizálta
kaptál már választ a kérdésedre? Ugyanezt próbálom megtenni több mint 3700 csv fájllal. Csak 1 oszlopot kell hozzáadnom (A).
A weboldal moderátora ezt a megjegyzést minimalizálta
Sziasztok rászoruló és Carly! A probléma megoldásához, több CSV-fájl kódjának futtatásához csak módosítania kell az .xls fájl kiterjesztését .csv-re, az alábbi kód szerint: Sub LoopThroughFiles()
Dim xFd mint FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Ha xFd.Show = -1 Akkor
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Tegye az xFileName <> "" közben
Munkafüzetekkel. Nyissa meg (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Oszlopok("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Vége
xFileName = Dir
Hurok
Ha véget
Az alprogram vége Kérjük, próbálja meg, remélem segíthet!
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia, lehetséges-e a makrót csak a különböző, meghatározott nevű munkafüzetek lapjain futtatni? Kösz!!
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Sara,
Sajnos nincs jó megoldás az Ön által felvetett problémára.
Köszönöm!
Még senki sem írt megjegyzést
Több ingatlan
Hagyja meg észrevételeit
Feladás vendégként
×
Értékeld ezt a bejegyzést:
0   Karakterek
Javasolt helyek

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi