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

Hvordan køres en makro på tværs af flere projektmappefiler?

Denne artikel vil jeg tale om, hvordan man kører en makro på tværs af flere projektmappefiler på samme tid uden at åbne dem. Følgende metode kan hjælpe dig med at løse denne opgave i Excel.

Kør en makro på tværs af flere projektmapper med VBA-kode

Kør en makro på tværs af flere projektmapper med VBA-kode

Hvis du vil køre en makro på tværs af flere projektmapper uden at åbne dem, skal du anvende følgende VBA-kode:

1. Hold nede ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. Klik indsatte > Moduler, og indsæt følgende makro i Moduler Vindue.

VBA-kode: Kør den samme makro på flere projektmapper på samme tid:

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

Bemærk: I ovenstående kode skal du kopiere og indsætte din egen kode uden Under overskrift og End Sub sidefod mellem Med arbejdsbøger. Åben (xFdItem & xFileName) og Slut med scripts. Se skærmbillede:

doc kør makro flere filer 1

3. Tryk derefter på F5 nøgle til at udføre denne kode, og a Gennemse vindue vises, skal du vælge en mappe, der indeholder de projektmapper, som du alle vil anvende denne makro, se skærmbillede:

doc kør makro flere filer 2

4. Og klik derefter på OK knappen, udføres den ønskede makro på én gang fra en projektmappe til andre.

 

De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund

 

Sorter kommentarer efter
Ældste først
Nyeste først
Kommentarer (43)
Bedømt 4.5 ud af 5 · 1 vurderinger
Iulia Curtman
Iulia Curtman
Denne kommentar blev minimeret af moderatoren på webstedet
Meget nyttig makro, og det fungerer fint, men jeg vil gerne kunne vælge hvilke filer fra den mappe, jeg vil have makroen kørt på? Filerne genereres ikke automatisk i en separat mappe, og jeg skal køre forskellige makroer på hvert sæt filer fra den mappe og derefter flytte dem tilbage i den oprindelige mappe.
Svar
Rapport
0
0
yarto logistik
yarto logistik
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg fulgte instruktionerne, men får en kompileringsfejl "Loop wihtout Do". Hvad overser jeg? Min makrokode er meget enkel, bare skift skriftstørrelse på angivne rækker. Fungerer af sig selv. Her er hvad jeg har... hjælp venligst

Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnavn = Dir(xFdItem & "*.xls*")
Gør mens xFileName <> ""
Med arbejdsbøger. Åben (xFdItem & xFileName)
'din kode her
Rows("2:8"). Vælg
Med Selection.Font
.Name = "Arial"
.Størrelse = 12
.Strikethrough = Falsk
.Overskrift = Falsk
.Subscript = Falsk
.OutlineFont = Falsk
.Shadow = Falsk
.Underline = xlUnderlineStyleIngen
.Farve = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontIngen
Slut med
xFilnavn = Dir
Loop
End If
End Sub
Svar
Rapport
0
0
skyyang
skyyang     yarto logistik
Denne kommentar blev minimeret af moderatoren på webstedet
Hej yarto,
Du gik glip af "Afslut med" scriptet i slutningen af ​​din kode, det korrekte skulle være dette:
Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnavn = Dir(xFdItem & "*.xls*")
Gør mens xFileName <> ""
Med arbejdsbøger. Åben (xFdItem & xFileName)
'din kode her
Rows("2:8"). Vælg
Med Selection.Font
.Name = "Arial"
.Størrelse = 16
.Strikethrough = Falsk
.Overskrift = Falsk
.Subscript = Falsk
.OutlineFont = Falsk
.Shadow = Falsk
.Underline = xlUnderlineStyleIngen
.Farve = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontIngen
Slut med
Slut med
xFilnavn = Dir
Loop
End If
End Sub

Prøv det, håber det kan hjælpe dig!
Svar
Rapport
0
0
Joel
Joel
Denne kommentar blev minimeret af moderatoren på webstedet
Meget anvendelig makro, og den fungerer godt, men jeg vil gerne have mulighed for at vælge, hvilke filer fra den mappe, jeg ønsker, at makroen skal køres på? For eksempel har jeg 4 filer i en mappe med andre Excel-filer, og jeg vil kun have det kørte på de 4 specifikke filer. Hvordan kan jeg justere din makro, så jeg kan vælge de 4 filer fra den mappe?
Svar
0
0
skyyang
skyyang     Joel
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Joel,
For at udløse den samme kode i specifikke projektmapper skal du anvende nedenstående kode:

Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Dim xFB som streng
Med Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = Sand
.Filtre.Ryd
.Filtre.Tilføj "excel", "*.xls*"
.At vise
Hvis .SelectedItems.Count < 1 Afslut Sub
For lngCount = 1 Til .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Hvis xFilnavn <> "" Så
With Workbooks.Open(Filename:=xFileName)
'din kode
Slut med
End If
Næste lngCount
Slut med
End Sub

Prøv det, håber det kan hjælpe dig!
Svar
Rapport
0
0
BELEMA
BELEMA     skyyang
Denne kommentar blev minimeret af moderatoren på webstedet
tak, var virkelig hjælpsom
Svar
0
0
Ltrung
Ltrung     skyyang
Denne kommentar blev minimeret af moderatoren på webstedet
Hej!

Jeg forsøger at indsætte min kode i din, og når jeg kører makroen, giver den mig følgende besked: Run-time error '429': ActiveX kan ikke oprette objektet. Venligst rådgivet om, hvordan det kan rettes. Tak skal du have!

Min kode:

Indstil RInput = Range("A2:A21")
Indstil ROoutput = Range("D2:D22")

Dim A() Som Variant
ReDim A(1 til RInput.Rows.Count, 0)
A = RInput.Værdi2

Indstil d = CreateObject("Scripsting.Dictionary")

For i = 1 til UBound(A)
Hvis d.Eksisterer(A(i, 1)) Så
d(A(i, 1)) = d(A(i, 1)) + 1
Else
d. Tilføj A(i, 1), 1
End If
Næste
For i = 1 til UBound(A)
A(i, 1) = d(A(i, 1))
Næste

ROoutput = A
Svar
Rapport
0
0
Caitlin Jarvis
Caitlin Jarvis
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, først tak for denne makro, det var præcis hvad jeg ledte efter. Jeg har dog et problem, er der en måde at lukke og gemme som hvert vindue, efterhånden som det afsluttes. Jeg har en stor mængde filer, og jeg er ved at løbe tør for RAM, før udførelsen er færdig.
Svar
Rapport
0
0
Manvir Rai
Manvir Rai     Caitlin Jarvis
Denne kommentar blev minimeret af moderatoren på webstedet
Ja, tilføj blot din følgende kode nedenfor, hvis du ønsker, at den skal gemme filen med samme navn:

'Gemmer arbejdsbogen
ActiveWorkbook.Save
Svar
0
0
skyyang
skyyang     Caitlin Jarvis
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Caitlin,
Måske kan nedenstående kode hjælpe dig, hver gang efter at du har kørt din specifikke kode, vil en gem-fil-promptboks springe ud, der minder dig om at gemme projektmappen.

Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Dim xWB Som arbejdsbog
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnavn = Dir(xFdItem & "*.xls*")
On Error Resume Next
Gør mens xFileName <> ""
Indstil xWB = Workbooks.Open(xFdItem & xFileName)
Med xWB
'din kode her
Slut med
xWB.Luk
xFilnavn = Dir
Loop
End If
End Sub
Svar
Rapport
0
0
Ltrung
Ltrung
Denne kommentar blev minimeret af moderatoren på webstedet
Hej!

Jeg forsøger at indsætte min kode i din, og når jeg kører makroen, giver den mig følgende besked: Run-time error '429': ActiveX kan ikke oprette objektet. Venligst rådgivet om, hvordan det kan rettes. Tak skal du have!

Min kode:

Indstil RInput = Range("A2:A21")
Indstil ROoutput = Range("D2:D22")

Dim A() Som Variant
ReDim A(1 til RInput.Rows.Count, 0)
A = RInput.Værdi2

Indstil d = CreateObject("Scripsting.Dictionary")

For i = 1 til UBound(A)
Hvis d.Eksisterer(A(i, 1)) Så
d(A(i, 1)) = d(A(i, 1)) + 1
Else
d. Tilføj A(i, 1), 1
End If
Næste
For i = 1 til UBound(A)
A(i, 1) = d(A(i, 1))
Næste

ROoutput = A
Svar
Rapport
0
0
Spring over Borowicz
Spring over Borowicz
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Jeg har brugt denne makro med succes til at formatere NBA-filer til de 30 hold med hver sin bog. I går modtog jeg en fejlmeddelelse om, at modul (makro) ikke kan fuldføres eller slettes eller redigeres (skal gemmes). Det har ødelagt min personlige makroprojektmappe og gjort Excel praktisk talt ubrugelig for mig. Den bryder appen ned, hver gang jeg forsøger at få adgang til en makro fra en hvilken som helst fil. Excel-understøttelse og Windows-understøttelse har ikke været i stand til at rette ting. Kan du hjælpe?
Svar
0
0
Deepak
Deepak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, Er der en måde jeg kan definere fildestinationen i selve scriptet. Jeg vil springe proces 3 over, hvor vi skal gennemse den specifikke mappe.
Svar
0
0
Arsalan
Arsalan
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, tak for denne kode. kan du venligst fortælle mig, hvordan kan jeg få resultatet af min makro, som jeg åbnede alle projektmapper for i ét ark (resultatet af hver projektmappe i træk)? og er der en måde at tilføje navnet på hver projektmappe til rækken med dataene fra det forrige trin?
Svar
0
0
aldc
aldc
Denne kommentar blev minimeret af moderatoren på webstedet
Hi

Jeg fik en 1004 run-time fejl: syntaks er ikke korrekt, da jeg kørte følgende kode, som er Extend Office VBA til "Kør en makro på samme tværs af flere projektmapper med VBA-kode" med Extend Office VBA "Slet alle navngivne områder med VBA-kode" i indsæt din kodeplads:

Sub LoopThroughFiles()

Dim xFd som fildialog

Dim xFdItem som variant

Dim xFileName Som streng

Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)

Hvis xFd.Show = -1 Så

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

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

Gør mens xFileName <> ""

Med arbejdsbøger. Åben (xFdItem & xFileName)

' Sub DeleteNames()

'Opdatering 20140314

Dim xName Som Navn

For hvert xnavn i Application.ActiveWorkbook.Names

xNavn.Slet

Næste


Slut med

xFilnavn = Dir

Loop

End If

End Sub

Det, jeg forsøger at gøre, er at køre en makro, der sletter de navngivne områder i otte projektmapper, der er indeholdt i den samme mappe.

BTW, det er første gang, jeg har brugt noget fra Extend Office, og det har ikke virket. Denne hjemmeside har været yderst hjælpsom for mig.

Forslag/kommentarer vil blive meget værdsat.

aldc
Svar
Rapport
0
0
skyyang
skyyang     aldc
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, aldc,
Din kode fungerer godt i min projektmappe, hvilken Excel-version bruger du?
Svar
Rapport
0
0
Oscar Fernholm
Oscar Fernholm
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, denne kode er så god og nyttig. Jeg bruger det meget!

I dag bruger vi i min organisation SharePoint til at gemme vores filer. Er der nogen måde at få denne kode til at virke på tværs af alle filer i en sharepoint-mappe?
Svar
1
0
Darko
Darko
Denne kommentar blev minimeret af moderatoren på webstedet
Hej tak for denne kode.
Er der også en måde at gå gennem undermapper på? Lad os sige, at jeg har én mappe og i mappen ti yderligere mapper, der hver indeholder en excel-fil.

Er der en måde at bare vælge den primære mappe, så koden løber gennem alle dens undermapper?

Tak.
Svar
0
0
skyyang
skyyang     Darko
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Darko, For at køre en kode fra en mappe med undermapperne skal du anvende følgende kode: Sub LoopThroughFiles_Subfolders(xStrPath As String)
Dim xSFolderName
Dim xFilnavn
Dim xArrSFPath() Som streng
Dim xI Som heltal
Hvis xStrPath = "" Afslut Sub
xFilnavn = Dir(xStrPath & "*.xls*")
Gør mens xFileName <> ""
Med Workbooks.Open(xStrPath & xFileName)
'din kode her
Slut med
xFilnavn = Dir
Loop
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
Gør mens xSFolderName <> ""
Hvis xSFolderName <> "." Og xSFolderName <> ".." Derefter
Hvis (GetAttr(xStrPath & xSFolderName) Og vbDirectory) = vbDirectory Så
xI = xI + 1
ReDim Preserve xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
End If
End If
xSFolderName = Dir
Loop
Hvis UBound(xArrSFPath) > 0 Så
For xI = 0 Til UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Næste xI
End If
End Sub
Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
End If
Afslut SubPrøv venligst, håber det kan hjælpe dig!
Svar
Rapport
0
0
Sal
Sal
Denne kommentar blev minimeret af moderatoren på webstedet
Ud over ovenstående kode, er det muligt at åbne excel-filer i en kronologisk rækkefølge, jeg ønskede?
Svar
0
0
Surya
Surya
Denne kommentar blev minimeret af moderatoren på webstedet
Hej først og fremmest mange tak for makroen den er virkelig praktisk at arbejde med. Jeg tænkte bare på, om vi har en måde at opdatere mappen i onedrive via makro. Hvis ja, kan du venligst fortælle mig, hvad kan jeg gøre her for at opdatere filerne i onedrive ved hjælp af makroscript?
Svar
Rapport
0
0
Turbalf
Turbalf
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, mange tak for dette script, jeg fungerer meget fint for mig, men jeg har specielle behov: Er der en måde at ændre scriptet for at anvende min kode med filnavnsbetingelser OG i undermapper?
Jeg forklarer: Jeg er lærer, og jeg har lavet en excel-løsning for at gemme elevernes resultater og give lærerne mulighed for at konsultere dem. For at gøre det har jeg en fil pr. skolefag og en til den ansvarlige klasse, alt sammen i en mappe pr. klasse.
Så når jeg finder en fejl eller en optimering, skal jeg rapportere ændringerne i alle filer i alle undermapper.
Men da alle filer ikke er ens (forskellige subjets-organisation), vil jeg gerne have en måde at anvende min kode på f.eks. alle filer med navnet "matematikklasse" i alle undermapperne, eller tværtimod at anvende min kode på alle filer i undermapper undtagen alle filer med navnet "xyz".Tak !Fabrice
Svar
Rapport
0
0
Muhammad Naveed
Muhammad Naveed
Denne kommentar blev minimeret af moderatoren på webstedet
Din givne kode virker ikke med følgende VBA, kan du hjælpe Sub Bundles()

Dim vWS som arbejdsark
Dæmp vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Indstil vWS = ActiveSheet
Med vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2(1 til vSum, 1 til 4)
vA = .Range("A2:D" & vR)
For vN = 1 Til vR - 1
For vN2 = 1 til vA(vN, 4)
vC = vC + 1
For vN3 = 1 til 4
vA2(vC, vN3) = vA(vN, vN3)
Næste vN3
Næste vN2
Næste vN
Slut med
vC = 1
For vN = 1 Til vSum - 2
vA2(vN, 4) = vC
Hvis vA2(vN + 1, 2) = vA2(vN, 2) Så
vC = vC + 1
vA2(vN + 1, 4) = vC
Else
vA2(vN + 1, 4) = 1
vC = 1
End If
Næste vN
Application.ScreenUpdating = False
Ark.Tilføj
Med ActiveSheet
vWS.Range("A1:D1"). Kopier .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
Slut med
Application.ScreenUpdating = True

End Sub
Svar
0
0
M Naveed
M Naveed
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg vil køre denne VBA ind i flere ark i en mappe ad gangen, kan du venligst hjælpeSub Bundles()

Dim vWS som arbejdsark
Dæmp vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Indstil vWS = ActiveSheet
Med vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2(1 til vSum, 1 til 4)
vA = .Range("A2:D" & vR)
For vN = 1 Til vR - 1
For vN2 = 1 til vA(vN, 4)
vC = vC + 1
For vN3 = 1 til 4
vA2(vC, vN3) = vA(vN, vN3)
Næste vN3
Næste vN2
Næste vN
Slut med
vC = 1
For vN = 1 Til vSum - 2
vA2(vN, 4) = vC
Hvis vA2(vN + 1, 2) = vA2(vN, 2) Så
vC = vC + 1
vA2(vN + 1, 4) = vC
Else
vA2(vN + 1, 4) = 1
vC = 1
End If
Næste vN
Application.ScreenUpdating = False
Ark.Tilføj
Med ActiveSheet
vWS.Range("A1:D1"). Kopier .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
Slut med
Application.ScreenUpdating = True

End Sub
Svar
Rapport
0
0
Ludivine S.
Ludivine S.
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg prøvede at køre koden, men fejlen "424 : Objekt påkrævet" vises på linjen "With Workbooks.Open(xFdItem & xFileName)". Ved at se dybere, ser det ud til, at excels-projektmapper, der er gemt i mappen af ​​interesse, ikke vises/eksisterer (når vinduet åbnes med kodevisningen, hvis jeg prøver at åbne mappen og ikke vælge den, er den tom). Hvordan det?
Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnavn = Dir(xFdItem & "*.xls*")
Gør mens xFileName <> ""
Med arbejdsbøger. Åben (xFdItem & xFileName)
Sheets.Add After:=ActiveSheet
Sheets("Sheet2"). Vælg
Sheets("Sheet2").Name = "Master"
Sheets ("Master"). Vælg
Sheets("Master").Move Before:=Sheets(1)
Slut med
xFilnavn = Dir
Loop
End If
End Sub


Kan du hjælpe mig med at løse dette problem?
Svar
0
0
gæst
gæst
Denne kommentar blev minimeret af moderatoren på webstedet
Dette er mit yndlingswebsted med de absolut klareste instruktioner (mere end nogen YouTube-video), og jeg vender tilbage til det igen og igen. Mange tak for disse tutorials - du er en trist studerendes livredder.
Svar
0
0
trængende
trængende
Denne kommentar blev minimeret af moderatoren på webstedet
Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnavn = Dir(xFdItem & "*.xls*")
Gør mens xFileName <> ""
Med arbejdsbøger. Åben (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Slut med
xFilnavn = Dir
Loop
End If
End Sub, venligst hjælp. BTW, min excel-filudvidelse er (.csv - "kommasepareret") . og jeg har 500 excel-filer i en mappe med hver række i gennemsnit på ca. 500000 antal rækker .. Please hjælp. Jeg vil bare indsætte spalte i hver projektmappe
Svar
0
0
Carly Benjamin
Carly Benjamin     trængende
Denne kommentar blev minimeret af moderatoren på webstedet
har du nogensinde fået svar på dit spørgsmål? Jeg forsøger at gøre det samme med over 3700 csv-filer. Jeg skal bare tilføje 1 kolonne (A).
Svar
0
0
skyyang
skyyang     Carly Benjamin
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, trængende og Carly, For at løse dit problem, for at køre koden for flere CSV-filer, skal du blot ændre .xls-filtypen til .csv som vist nedenfor: Sub LoopThroughFiles()
Dim xFd som fildialog
Dim xFdItem som variant
Dim xFileName Som streng
Indstil xFd = Application.FileDialog(msoFileDialogFolderPicker)
Hvis xFd.Show = -1 Så
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFilnavn = Dir(xFdItem & "*.csv*")
Gør mens xFileName <> ""
Med arbejdsbøger. Åben (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
Slut med
xFilnavn = Dir
Loop
End If
Afslut SubPrøv venligst, håber det kan hjælpe dig!
Svar
Rapport
0
0
Sara
Sara
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, er det muligt kun at køre makroen i arkene i forskellige projektmapper med et bestemt navn? Tak!!
Svar
0
0
skyyang
skyyang     Sara
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Sara,
Beklager, der er ingen god løsning på det problem, du rejste.
Tak!
Svar
Rapport
0
0
Der er endnu ingen kommentarer her
Load More
Efterlad dine kommentarer
Gæst
Sender som gæst
Login
×
Bedøm dette indlæg:
Nulstil
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL