MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 07.11.2018, 11:36   #1
JonasSchmitt
Neuer Benutzer
Neuer Benutzer
Standard VBA - Optimierung eines Makros zum Einlesen aller Dateien in einem Ordner

Hi Leute,
und zwar habe ich ein Makro übernommen, welches mir alle Dateien in einem angegebenen Ordner und dessen Unterordner inklusive Pfad auflistet.

Hier erst mal das Makro (tut mir leid für die eventuell falsche Formatierung, ich bin ein absoluter Neuling in Foren):

Option Explicit
Option Compare Text

Const sRootPath As String = "C:xyz"
Private lRowCounter As Long
Private oSheet As Object

'Start der Routine: Call MWDateienMitUnterordnernAuslesen

Public Sub MWDateienMitUnterordnernAuslesen()
Set oSheet = Sheets.Add
oSheet.Activate
oSheet.Cells(1, 1).Select
Call CreateHeadLinesAndFormat
lRowCounter = 2
Call MWReadSubFolder(sRootPath)
Set oSheet = Nothing
End Sub

Private Sub CreateHeadLinesAndFormat()
Dim i As Long

oSheet.Cells(1, 1) = "Pfad"
oSheet.Cells(1, 2) = "Dateiname"
oSheet.Columns(1).ColumnWidth = 70
oSheet.Columns(2).ColumnWidth = 70
oSheet.Columns(3).ColumnWidth = 10
oSheet.Columns(4).ColumnWidth = 10

For i = 1 To 2
With oSheet
.Cells(1, i).Interior.ColorIndex = 11
.Cells(1, i).Font.Color = vbWhite
.Cells(1, i).Font.Bold = True
End With
Next i


Range("A1").Select
Selection.Copy
Range("C1: D1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C1").Select
ActiveCell.FormulaR1C1 = "Länge Pfad"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Länge Dateiname"
Columns("C:C").Select
Selection.ColumnWidth = 10
Columns("D: D").Select
Selection.ColumnWidth = 10
Range("C2").Select
ActiveCell.FormulaR1C1 = "=LEN(RC[-2])"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=LEN(RC[-2])"
Range("D3").Select

Columns("C:C").Select
Selection.AutoFilter

Columns("D: D").Select
Selection.AutoFilter



End Sub

Private Sub MWReadSubFolder(ByVal sPath As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sPath)

With oSheet

For Each oSubFolder In oFolder.subfolders

'Alle Dateien auflisten
For Each oFile In oSubFolder.Files
.Cells(lRowCounter, 1) = oSubFolder.Path
.Cells(lRowCounter, 2) = oFile.Name
lRowCounter = lRowCounter + 1
Next oFile

'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)

Next oSubFolder

End With

Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing
End Sub


Jedoch habe ich hierbei ein paar Probleme:

1. funktioniert der Absatz mit dem Filter nicht.

Columns("C:C").Select
Selection.AutoFilter

Columns("D: D").Select
Selection.AutoFilter


2. hätte ich gerne, dass sich Spalte C und D, in der auch der Filter sein soll, mittig in der Zelle angeordnet sein soll.

3. Soll die Länge aller Dateipfade und -namen gezählt werden, hierzu eben die Zeilen:

[font="Courier New"][size="2"][color="RoyalBlue"] Range("C2").Select
ActiveCell.FormulaR1C1 = "=LEN(RC[-2])"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=LEN(RC[-2])"

Jedoch funktioniert dies nur für die Zellen C2 und D2, die Formel müsste jedoch bis zur letzten beschriebenen Zeile kopiert werden. All meine Versuche scheiterten hierzu leider...


Ich hoffe sehr, dass ihr mir hierbei helfen könnt!

Grüße, euer Jonas
JonasSchmitt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.11.2018, 12:30   #2
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Jonas,

wenn du schreibst "es funktioniert der Absatz mit dem Filter nicht", dann ist das nur heiße Luft. WAS funktioniert denn nicht und WAS hättest du gerne?

Zu 2: Ich nehme an, dass du meinst, dass die Zelleninhalte zentriert dargestellt werden sollen?
Die Punkte 2 und 3 kannst du ganz simpel mit dem Makrorekorder lösen. Markiere beide Spalten und zentriere den Inhalt. Danach gibst du in C2 und D2 deine gewünschten Formeln ein und kopierst sie mittels Doppelklick auf das rechte untere Zelleneck nach unten. Das nennt man Autoausfüllen. Das alles machst du, während der Makrorekorder läuft und schon hast du deinen Code.

Zum Thema Format: Es gibt für Code die Codetags, das ist der Button auf dem Bild. Da setzt du deinen Code hier im Forum dazwischen.
Angehängte Grafiken
Dateityp: png Codetages.PNG (4,6 KB, 4x aufgerufen)

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 07.11.2018, 15:26   #3
Hans Hofmann
MOF Koryphäe
MOF Koryphäe
Standard

...und es wäre eine gute Idee die Selectierei abzuschaffen.
Alle Schritte, die auf Select enden und in der nächsten Zeile mit Selection oder ActiveCell weiter machen:

Range("A1").Select
Selection.Copy

zusammenfassen zu

Range("A1").Copy

Vielleicht hilft das schon weiter?

__________________

Gruß HW

WebSite: Veröffentlichungen zu PP & VBA

Hans Hofmann ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 15:04   #4
JonasSchmitt
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo Hans, ich hab den Code dahingehend verkürzt und übersichtlicher gemacht, geholfen hat es jedoch nicht. Aber trotzdem danke.

Auch ein Dankeschön an MisterBurns, der Tipp mit dem Makrorekorder war super. Hatte ich zuvor auch schon versucht, jedoch wieder aufgegeben. Nun funktioniert es nach etwas Heck-Meck aber ausgezeichnet.

Jetzt ist mir jedoch noch ein weiteres Problem aufgefallen: Jedes mal, wenn ich das Makro laufen lasse, öffnet es mir ein neues Tabellenblatt. Ich bin noch unentschlossen, wie ich damit umgehen will.

Gibt es die Möglichkeit, das Tabellenblatt automatisch im Makro auf das heutige Datum umzubenennen? Wenn nicht, in wie fern muss ich den vorhandenen Code abändern, sodass er nicht jedes mal eine neue Tabelle öffnet, sondern das aktuelle Blatt überschreibt?


Vielen Dank im Voraus
Euer Jonas
JonasSchmitt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 15:21   #5
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Code:

ActiveSheet.Name = Date
bzw. in deinem Fall auch
Code:

osheet.Name = Date

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 15:45   #6
JonasSchmitt
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Super, das war ja mega easy

Jetzt besteht nur noch die Frage, wie ich das Öffnen eines neuen Blattes verhindern kann. Ich dachte, ich lösche einfach die Zeile

Code:

Set oSheet = Sheets.Add
aber das hat leider nicht funktioniert. War wohl doch zu stupide gedacht
JonasSchmitt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 10:28   #7
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Wie jetzt, du löschst die Zeile
Code:

Set oSheet = Sheets.Add
und trotzdem wird noch ein neues Tabellenblatt erstellt? Das kann ich ja fast nicht glauben.

Aber ersetze diese Zeile doch einfach mal durch
Code:

Set oSheet = ActiveSheet

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 15:24   #8
JonasSchmitt
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Berni, du bist der Beste!

Ich hatte die Zeile einfach gelöscht und habe somit eine Fehlermeldung bekommen, die ich selbstständig nicht lösen konnte.

Aber jetzt funktioniert alles wunderbar. Vielen Dank!

Euer Jonas
JonasSchmitt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 16:54   #9
MisterBurns
MOF Koryphäe
MOF Koryphäe
Standard

Zitat:

du bist der Beste!

Tja tja, das sage ich meiner Frau auch immer, aber irgendwie will sie das nicht verstehen

__________________

Schöne Grüße
Berni
MisterBurns ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:27 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.