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

Wie kann ein Makro gleichzeitig über mehrere Arbeitsmappendateien ausgeführt werden?

In diesem Artikel werde ich darüber sprechen, wie ein Makro über mehrere Arbeitsmappendateien gleichzeitig ausgeführt wird, ohne sie zu öffnen. Die folgende Methode kann Ihnen helfen, diese Aufgabe in Excel zu lösen.

Führen Sie ein Makro gleichzeitig über mehrere Arbeitsmappen mit VBA-Code aus

Führen Sie ein Makro gleichzeitig über mehrere Arbeitsmappen mit VBA-Code aus

Wenden Sie den folgenden VBA-Code an, um ein Makro über mehrere Arbeitsmappen hinweg auszuführen, ohne diese zu öffnen:

1. Halten Sie die Taste gedrückt ALT + F11 Schlüssel zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.

2. Klicken Sie Insert > Modulund fügen Sie das folgende Makro in das Feld ein Modul Fenster.

VBA-Code: Führen Sie dasselbe Makro auf mehreren Arbeitsmappen gleichzeitig aus:

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

Hinweis: Kopieren Sie im obigen Code Ihren eigenen Code und fügen Sie ihn ohne den Code ein Sub Überschrift und End Sub Fußzeile zwischen dem Mit Workbooks.Open (xFdItem & xFileName) und Ende mit Skripte. Siehe Screenshot:

doc Makro mehrere Dateien ausführen 1

3. Dann drücken F5 Schlüssel zum Ausführen dieses Codes und a Entdecken Wenn das Fenster angezeigt wird, wählen Sie einen Ordner aus, der die Arbeitsmappen enthält, auf die Sie dieses Makro anwenden möchten. Siehe Screenshot:

doc Makro mehrere Dateien ausführen 2

4. Und dann klick OK Mit der Schaltfläche wird das gewünschte Makro sofort von einer Arbeitsmappe zur anderen ausgeführt.

 

Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formelriegel (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2021 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. 30-tägige kostenlose Testversion mit allen Funktionen. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
officetab unten

 

Kommentare (43)
Bewertet 4.5 aus 5 · 1 Bewertungen
Julia Curtmann
Julia Curtmann
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Sehr nützliches Makro, und es funktioniert gut, aber ich würde gerne auswählen können, für welche Dateien aus diesem Ordner das Makro ausgeführt werden soll? Die Dateien werden nicht automatisch in einem separaten Ordner generiert, und ich muss verschiedene Makros für jeden Satz von Dateien aus diesem Ordner ausführen und sie dann zurück in den ursprünglichen Ordner verschieben.
antworten
Report
0
0
yarto Logistik
yarto Logistik
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe die Anweisungen befolgt, bekomme aber einen Kompilierfehler "Loop ohne Do". Was vermisse ich? Mein Makrocode ist sehr einfach, ändern Sie einfach die Schriftgröße der angegebenen Zeilen. Funktioniert von alleine. Hier ist, was ich habe ... bitte helfen Sie

Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Mit Workbooks.Open (xFdItem & xFileName)
'Ihr Code hier
Zeilen ("2:8").Auswählen
Mit Selection.Font
.Name = "Arial"
.Größe = 12
.Durchgestrichen = Falsch
.Hochgestellt = Falsch
.Index = Falsch
.OutlineFont = Falsch
.Schatten = Falsch
.Underline = xlUnderlineStyleNone
.Farbe = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Ende mit
xDateiname = Verz
Loop
End If
End Sub
antworten
Report
0
0
skyyang
skyyang     yarto Logistik
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Jarto,
Sie haben das Skript "Ende mit" am Ende Ihres Codes verpasst, das richtige sollte das sein:
Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Mit Workbooks.Open (xFdItem & xFileName)
'Ihr Code hier
Zeilen ("2:8").Auswählen
Mit Selection.Font
.Name = "Arial"
.Größe = 16
.Durchgestrichen = Falsch
.Hochgestellt = Falsch
.Index = Falsch
.OutlineFont = Falsch
.Schatten = Falsch
.Underline = xlUnderlineStyleNone
.Farbe = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Ende mit
Ende mit
xDateiname = Verz
Loop
End If
End Sub

Bitte versuchen Sie es, ich hoffe, es kann Ihnen helfen!
antworten
Report
0
0
Joel
Joel
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Sehr nützliches Makro, und es funktioniert großartig, aber ich würde gerne auswählen können, für welche Dateien aus diesem Ordner das Makro ausgeführt werden soll? Zum Beispiel habe ich 4 Dateien in einem Ordner mit anderen Excel-Dateien und ich möchte, dass es nur für diese 4 spezifischen Dateien ausgeführt wird. Wie kann ich Ihr Makro optimieren, damit ich diese 4 Dateien aus diesem Ordner auswählen kann?
antworten
0
0
skyyang
skyyang     Joel
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Joel,
Um denselben Code in bestimmten Arbeitsmappen auszulösen, sollten Sie den folgenden Code anwenden:

Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
xFB als String dimmen
Mit Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Filter.Löschen
.Filter.Add "excel", "*.xls*"
.Zeigen
Wenn .SelectedItems.Count < 1, dann Sub verlassen
Für lngCount = 1 bis .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Wenn xDateiname <> "" Dann
Mit Workbooks.Open(Dateiname:=xDateiname)
'dein Code
Ende mit
End If
Nächster lngCount
Ende mit
End Sub

Bitte versuchen Sie es, ich hoffe, es kann Ihnen helfen!
antworten
Report
0
0
Belema
Belema     skyyang
Dieser Kommentar wurde vom Moderator auf der Website minimiert
danke, war echt hilfreich
antworten
0
0
Ltr
Ltr     skyyang
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hi!

Ich versuche, meinen Code in Ihren einzufügen, und wenn ich das Makro ausführe, erhalte ich die folgende Meldung: Laufzeitfehler '429': ActiveX kann das Objekt nicht erstellen. Bitte beraten, wie es behoben werden kann. Danke!

Mein Code:

Setze RInput = Range("A2:A21")
Setze ROutput = Range("D2:D22")

Dim A() als Variante
ReDim A(1 bis RInput.Rows.Count, 0)
A = REingabe.Wert2

Set d = CreateObject("Scriptsting.Dictionary")

Für i = 1 zu UBound(A)
Wenn d. Existiert (A (i, 1)) Dann
d(A(i, 1)) = d(A(i, 1)) + 1
sonst
d.Addiere A(i, 1), 1
End If
Weiter
Für i = 1 zu UBound(A)
A(i, 1) = d(A(i, 1))
Weiter

RAusgang = A
antworten
Report
0
0
Caitlin Jarvis
Caitlin Jarvis
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, erstmal vielen Dank für dieses Makro, es war genau das, wonach ich gesucht habe. Ich habe jedoch ein Problem: Gibt es eine Möglichkeit, jedes Fenster nach Abschluss zu schließen und zu speichern? Ich habe eine große Menge an Dateien und mir geht der Arbeitsspeicher aus, bevor die Ausführung abgeschlossen ist.
antworten
Report
0
0
Manvir Rai
Manvir Rai     Caitlin Jarvis
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ja, fügen Sie einfach den folgenden Code hinzu, wenn Sie möchten, dass die Datei mit demselben Namen gespeichert wird:

'Speichern der Arbeitsmappe
ActiveWorkbook.Speichern
antworten
0
0
skyyang
skyyang     Caitlin Jarvis
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Caitline,
Vielleicht kann Ihnen der folgende Code helfen, jedes Mal, nachdem Sie Ihren spezifischen Code ausgeführt haben, erscheint eine Eingabeaufforderung zum Speichern der Datei, die Sie daran erinnert, die Arbeitsmappe zu speichern.

Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Dim xWB als Arbeitsmappe
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Do While xFileName <> ""
Setze xWB = Workbooks.Open(xFdItem & xFileName)
Mit xWB
'Ihr Code hier
Ende mit
xWB.Close
xDateiname = Verz
Loop
End If
End Sub
antworten
Report
0
0
Ltr
Ltr
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hi!

Ich versuche, meinen Code in Ihren einzufügen, und wenn ich das Makro ausführe, erhalte ich die folgende Meldung: Laufzeitfehler '429': ActiveX kann das Objekt nicht erstellen. Bitte beraten, wie es behoben werden kann. Danke!

Mein Code:

Setze RInput = Range("A2:A21")
Setze ROutput = Range("D2:D22")

Dim A() als Variante
ReDim A(1 bis RInput.Rows.Count, 0)
A = REingabe.Wert2

Set d = CreateObject("Scriptsting.Dictionary")

Für i = 1 zu UBound(A)
Wenn d. Existiert (A (i, 1)) Dann
d(A(i, 1)) = d(A(i, 1)) + 1
sonst
d.Addiere A(i, 1), 1
End If
Weiter
Für i = 1 zu UBound(A)
A(i, 1) = d(A(i, 1))
Weiter

RAusgang = A
antworten
Report
0
0
Borowicz überspringen
Borowicz überspringen
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo,

Ich habe dieses Makro erfolgreich verwendet, um NBA-Dateien für die 30 Teams mit jeweils einem eigenen Buch zu formatieren. Gestern erhielt ich eine Fehlermeldung, dass das Modul (Makro) nicht abgeschlossen oder gelöscht oder bearbeitet werden kann (zu speichern). Es hat meine persönliche Makro-Arbeitsmappe beschädigt und Excel für mich praktisch unbrauchbar gemacht. Die App stürzt jedes Mal ab, wenn ich versuche, von einer beliebigen Datei aus auf ein Makro zuzugreifen. Der Excel-Support und der Windows-Support waren nicht in der Lage, Probleme zu beheben. Kannst du helfen?
antworten
0
0
Deepak
Deepak
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, gibt es eine Möglichkeit, das Dateiziel im Skript selbst zu definieren. Ich möchte den Prozess 3 überspringen, in dem wir den bestimmten Ordner durchsuchen müssen.
antworten
0
0
Arsalan
Arsalan
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, danke für diesen Code. Können Sie mir bitte sagen, wie ich das Ergebnis meines Makros, für das ich alle Arbeitsmappen geöffnet habe, in einem Blatt haben kann (das Ergebnis jeder Arbeitsmappe in einer Reihe)? und gibt es eine Möglichkeit, den Namen jeder Arbeitsmappe der Zeile mit den Daten aus dem vorherigen Schritt hinzuzufügen?
antworten
0
0
alc
alc
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hi

Ich habe einen 1004-Laufzeitfehler erhalten: Die Syntax ist nicht korrekt, als ich den folgenden Code ausgeführt habe, bei dem es sich um das Extend Office VBA handelt, um „ein Makro gleichzeitig über mehrere Arbeitsmappen mit VBA-Code auszuführen“ mit dem Extend Office VBA „Alle benannten Bereiche löschen mit VBA-Code" in den Code-Slot einfügen:

Unter LoopThroughFiles()

Dim xFd As FileDialog

Dim xFdItem als Variante

Dim xFileName als Zeichenfolge

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

Wenn xFd.Show = -1 Dann

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

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

Do While xFileName <> ""

Mit Workbooks.Open (xFdItem & xFileName)

' Unter DeleteNames()

'Update 20140314

Dim xName als Name

Für jeden xName in Application.ActiveWorkbook.Names

xName.Löschen

Weiter


Ende mit

xDateiname = Verz

Loop

End If

End Sub

Was ich versuche, ist, ein Makro auszuführen, das die benannten Bereiche in acht Arbeitsmappen löscht, die im selben Ordner enthalten sind.

Übrigens, das ist das erste Mal, dass ich etwas von Extend Office verwende und es hat nicht funktioniert. Diese Website hat mir sehr geholfen.

Anregungen/Kommentare wären sehr willkommen.

alc
antworten
Report
0
0
skyyang
skyyang     alc
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Alc,
Ihr Code funktioniert gut in meiner Arbeitsmappe, welche Excel-Version verwenden Sie?
antworten
Report
0
0
Oskar Fernholm
Oskar Fernholm
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, dieser Code ist so gut und nützlich. Ich benutze es viel!

Heutzutage verwenden wir in meiner Organisation SharePoint zum Speichern unserer Dateien. Gibt es eine Möglichkeit, diesen Code für alle Dateien in einem Sharepoint-Ordner zu verwenden?
antworten
1
0
Darko
Darko
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, danke für diesen Code.
Gibt es eine Möglichkeit, auch Unterordner zu durchlaufen? Nehmen wir an, ich habe einen Ordner und innerhalb des Ordners zehn weitere Ordner, die jeweils eine Excel-Datei enthalten.

Gibt es eine Möglichkeit, einfach den primären Ordner auszuwählen, damit der Code alle seine Unterordner durchläuft?

Danke.
antworten
0
0
skyyang
skyyang     Darko
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, Darko, um einen Code aus einem Ordner mit den Unterordnern auszuführen, wenden Sie bitte den folgenden Code an: Sub LoopThroughFiles_Subfolders (xStrPath als String)
Dim xSOrdnername
Dim xDateiname
Dim xArrSFPath() als String
Dim xI als ganze Zahl
Wenn xStrPath = "" dann Sub beenden
xFileName = Dir(xStrPath & "*.xls*")
Do While xFileName <> ""
Mit Workbooks.Open(xStrPath & xFileName)
'Ihr Code hier
Ende mit
xDateiname = Verz
Loop
xSFolderName = Dir(xStrPath, vbVerzeichnis)
xI = 0
ReDim xArrSFPath(0)
Do While xSFolderName <> ""
Wenn xSOrdnername <> "." Und xSFolderName <> ".." Dann
If (GetAttr(xStrPath & xSFolderName) And vbDirectory) = vbDirectory Then
xI = xI + 1
ReDim Preserve xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
End If
End If
xSOrdnername = Verz
Loop
Wenn UBound(xArrSFPath) > 0 dann
Für xI = 0 zu UBound(xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Weiter xI
End If
End Sub
Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
LoopThroughFiles_Unterordner (xFdItem)
End If
End SubBitte versuchen Sie es, ich hoffe, es kann Ihnen helfen!
antworten
Report
0
0
Sal
Sal
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ist es zusätzlich zum obigen Code möglich, Excel-Dateien in einer von mir gewünschten chronologischen Reihenfolge zu öffnen?
antworten
0
0
surya
surya
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, zunächst einmal vielen Dank für das Makro, mit dem man wirklich praktisch arbeiten kann. Ich habe mich nur gefragt, ob wir eine Möglichkeit haben, den Ordner im Onedrive durch ein Makro zu aktualisieren. Wenn ja, könnten Sie mir bitte mitteilen, was ich hier tun kann, um die Dateien in Onedrive mit Makroskript zu aktualisieren?
antworten
Report
0
0
Turbalf
Turbalf
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, vielen Dank für dieses Skript, ich arbeite sehr gut für mich, aber ich habe besondere Bedürfnisse: Gibt es eine Möglichkeit, das Skript zu ändern, um meinen Code mit Dateinamenbedingungen UND in Unterordnern anzuwenden?
Ich erkläre: Ich bin Lehrer und habe eine Excel-Lösung erstellt, um die Ergebnisse der Schüler zu speichern und es den Lehrern zu ermöglichen, sie zu konsultieren. Dazu habe ich eine Datei pro Schulfach und eine für die zuständige Klasse, alles in einem Ordner pro Klasse.
Wenn ich also einen Fehler oder eine Optimierung finde, muss ich die Änderungen in allen Dateien in allen Unterordnern melden.
Da jedoch nicht alle Dateien gleich sind (unterschiedliche Organisation der Unterpunkte), möchte ich eine Möglichkeit, meinen Code par example auf alle Dateien mit dem Namen "Mathematikklasse" in allen Unterordnern anzuwenden oder meinen Code im Gegenteil auf alle Dateien anzuwenden in Unterordnern außer allen Dateien mit dem Namen "xyz". Danke !Fabrice
antworten
Report
0
0
Muhammad Naveed
Muhammad Naveed
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ihr angegebener Code funktioniert nicht mit folgendem VBA. Können Sie bitte helfen Sub Bundles ()

Dim vWS als Arbeitsblatt
Dim vA, vA2()
Dim vR so lang, vSum so lang, vC so lang
Dim vN so lang, vN2 so lang, vN3 so lang

Setzen Sie vWS = ActiveSheet
Mit vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Anwendung.Summe(.Range("D2:D" & vR))
ReDim Preserve vA2(1 bis vSum, 1 bis 4)
vA = .Range("A2:D" & vR)
Für vN = 1 bis vR - 1
Für vN2 = 1 bis vA(vN, 4)
vC = vC + 1
Für vN3 = 1 bis 4
vA2(vC, vN3) = vA(vN, vN3)
Nächstes vN3
Nächstes vN2
Nächste vN
Ende mit
vC = 1
Für vN = 1 bis vSum - 2
vA2(vN, 4) = vC
Wenn vA2(vN + 1, 2) = vA2(vN, 2) Dann
vC = vC + 1
vA2(vN + 1, 4) = vC
sonst
vA2(vN + 1, 4) = 1
vC = 1
End If
Nächste vN
Application.ScreenUpdating = False
Sheets.Add
Mit ActiveSheet
vWS.Range("A1:D1").Kopieren .Range("A1:D1")
.Zellen(2, 1).Resize(vSum, 4) = vA2
Ende mit
Application.ScreenUpdating = True

End Sub
antworten
0
0
M Naveed
M Naveed
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich möchte diese VBA in mehreren Blättern in einem Ordner gleichzeitig ausführen. Können Sie bitte Sub Bundles () helfen?

Dim vWS als Arbeitsblatt
Dim vA, vA2()
Dim vR so lang, vSum so lang, vC so lang
Dim vN so lang, vN2 so lang, vN3 so lang

Setzen Sie vWS = ActiveSheet
Mit vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Anwendung.Summe(.Range("D2:D" & vR))
ReDim Preserve vA2(1 bis vSum, 1 bis 4)
vA = .Range("A2:D" & vR)
Für vN = 1 bis vR - 1
Für vN2 = 1 bis vA(vN, 4)
vC = vC + 1
Für vN3 = 1 bis 4
vA2(vC, vN3) = vA(vN, vN3)
Nächstes vN3
Nächstes vN2
Nächste vN
Ende mit
vC = 1
Für vN = 1 bis vSum - 2
vA2(vN, 4) = vC
Wenn vA2(vN + 1, 2) = vA2(vN, 2) Dann
vC = vC + 1
vA2(vN + 1, 4) = vC
sonst
vA2(vN + 1, 4) = 1
vC = 1
End If
Nächste vN
Application.ScreenUpdating = False
Sheets.Add
Mit ActiveSheet
vWS.Range("A1:D1").Kopieren .Range("A1:D1")
.Zellen(2, 1).Resize(vSum, 4) = vA2
Ende mit
Application.ScreenUpdating = True

End Sub
antworten
Report
0
0
Ludivine S.
Ludivine S.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Ich habe versucht, den Code auszuführen, aber der Fehler „424: Objekt erforderlich“ wird in der Zeile „With Workbooks.Open(xFdItem & xFileName)“ angezeigt. Bei genauerer Betrachtung scheint es, dass die im interessierenden Ordner gespeicherten Excel-Arbeitsmappen nicht angezeigt werden/existieren (wenn das Fenster mit der Codeanzeige geöffnet wird und ich versuche, den Ordner zu öffnen und ihn nicht auszuwählen, ist er leer). Wie?
Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Mit Workbooks.Open (xFdItem & xFileName)
Sheets.Hinzufügen nach:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Master"
Blätter ("Master").Auswählen
Sheets("Master").Move Before:=Sheets(1)
Ende mit
xDateiname = Verz
Loop
End If
End Sub


Können Sie mir bitte helfen, dieses Problem zu lösen?
antworten
0
0
Gast
Gast
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Dies ist meine Lieblingswebsite mit den absolut klarsten Anweisungen (mehr als jedes YouTube-Video) und ich komme immer wieder darauf zurück. Vielen Dank für diese Tutorials - Sie sind der Lebensretter eines traurigen Studenten.
antworten
0
0
Bedürftige
Bedürftige
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
Mit Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Wählen
Ende mit
xDateiname = Verz
Loop
End If
End Sub, bitte helfen Sie . Übrigens, meine Excel-Dateierweiterung ist (.csv - "comma delimited"). und ich habe 500 Excel-Dateien in einem Ordner mit einer durchschnittlichen Anzahl von Zeilen von ca. 500000 Zeilen pro Zeile. Bitte helfen Sie. Ich möchte nur eine Spalte in jede Arbeitsmappe einfügen
antworten
0
0
Carly Benjamin
Carly Benjamin     Bedürftige
Dieser Kommentar wurde vom Moderator auf der Website minimiert
hast du schon mal eine antwort auf deine frage bekommen? Ich versuche, dasselbe mit über 3700 CSV-Dateien zu tun. Ich muss nur 1 Spalte (A) hinzufügen.
antworten
0
0
skyyang
skyyang     Carly Benjamin
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, bedürftig und Carly, um Ihr Problem zu lösen und den Code für mehrere CSV-Dateien auszuführen, müssen Sie nur die .xls-Dateierweiterung in .csv ändern, wie im folgenden Code gezeigt: Unter LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem als Variante
Dim xFileName als Zeichenfolge
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
Wenn xFd.Show = -1 Dann
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Do While xFileName <> ""
Mit Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Wählen
Ende mit
xDateiname = Verz
Loop
End If
End SubBitte versuchen Sie es, ich hoffe, es kann Ihnen helfen!
antworten
Report
0
0
Sara
Sara
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, ist es möglich, das Makro nur in den Blättern verschiedener Arbeitsmappen mit einem bestimmten Namen auszuführen? Vielen Dank!!
antworten
0
0
skyyang
skyyang     Sara
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Sara,
Entschuldigung, es gibt keine gute Lösung für das von Ihnen angesprochene Problem.
Vielen Dank!
antworten
Report
0
0
Es sind noch keine Kommentare vorhanden
Mehr laden
Hinterlassen Sie Ihre Kommentare
GUEST
Als Gast posten
Einloggen
×
Bewerte diese Nachricht:
Zurücksetzen
0   Figuren
Vorgeschlagene Standorte

Folgen Sie uns

Copyright © 2009 - www.extendoffice.com. | Alle Rechte vorbehalten. Unterstützt von ExtendOffice. | Sitemap
Microsoft und das Office-Logo sind Marken oder eingetragene Marken der Microsoft Corporation in den USA und / oder anderen Ländern.
Geschützt durch Sectigo SSL