Supportnet / Forum / Tabellenkalkulation
Excel Makro auf alle Excel Dateien in einem bestimmten Ordner anwenden
Frage
Hallo ich möchte ein Excel Makro basteln das in allen Excel Dateien eines bestimmten Ordners nachschaut ob ein # - Zeichen vorhanden ist und falls ja, dieses mit einem Leerzeichen ersetzt. Wie geh ich denn da am besten an das Problem ran ??
lg.
Roman
Antwort 1 von Saarbauer
Hallo,
wie siehen den die Dateinamen aus?
Ist eine Systemmatik drin oder ?
Das Makro würde ich aufzeichnen und im Makro mit "Ersetzen" das # gegen Leerzeichen austauschen.
Für das automatische Dateiöffnung wäre mit VBA ein Makro zu schreiben.
Gruß
Helmut
wie siehen den die Dateinamen aus?
Ist eine Systemmatik drin oder ?
Das Makro würde ich aufzeichnen und im Makro mit "Ersetzen" das # gegen Leerzeichen austauschen.
Für das automatische Dateiöffnung wäre mit VBA ein Makro zu schreiben.
Gruß
Helmut
Antwort 2 von Jogi1976
Hallo Helmut !!
Die Dateinamen sind leider bunt durcheinander gewürfet von der Bezeichnung her und es sind extrem viele >300 !!
@Für das automatische Dateiöffnung wäre mit VBA ein Makro zu schreiben.
Genau da scheitert es leider bei mir da ich keine Ahnung habe wie ich ihm mittels VBA sagen kann welche datei er als nächstes öffnen soll
Hast du da eine Lösung ??
vielen Dank schon im vorhinein
Roman
Die Dateinamen sind leider bunt durcheinander gewürfet von der Bezeichnung her und es sind extrem viele >300 !!
@Für das automatische Dateiöffnung wäre mit VBA ein Makro zu schreiben.
Genau da scheitert es leider bei mir da ich keine Ahnung habe wie ich ihm mittels VBA sagen kann welche datei er als nächstes öffnen soll
Hast du da eine Lösung ??
vielen Dank schon im vorhinein
Roman
Antwort 3 von nighty
hi all :))
eine variante :)))
gruss nighty
Option Explicit
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pIDList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Sub makro01()
Dim i As Integer, letzte As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Workbooks(2).Worksheets(1).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
Private Function Ordnerwählen(ByVal strTitle As String) As String
Dim lngIDList As Long
Dim strBuffer As String
Dim UserBrowseInfo As BrowseInfo
With UserBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat(strTitle, "")
.ulFlags = 3
End With
lngIDList = SHBrowseForFolder(UserBrowseInfo)
If (lngIDList) Then
strBuffer = Space(260)
SHGetPathFromIDList lngIDList, strBuffer
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Ordnerwählen = strBuffer
End If
End Function
eine variante :)))
gruss nighty
Option Explicit
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pIDList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Sub makro01()
Dim i As Integer, letzte As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Workbooks(2).Worksheets(1).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
Private Function Ordnerwählen(ByVal strTitle As String) As String
Dim lngIDList As Long
Dim strBuffer As String
Dim UserBrowseInfo As BrowseInfo
With UserBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat(strTitle, "")
.ulFlags = 3
End With
lngIDList = SHBrowseForFolder(UserBrowseInfo)
If (lngIDList) Then
strBuffer = Space(260)
SHGetPathFromIDList lngIDList, strBuffer
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Ordnerwählen = strBuffer
End If
End Function
Antwort 4 von nighty
hi all :)
der bereich wäre in dieser zeile anzupassen :)
gruss nighty
Workbooks(2).Worksheets(1).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
der bereich wäre in dieser zeile anzupassen :)
gruss nighty
Workbooks(2).Worksheets(1).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Antwort 5 von nighty
hi all :)
noch eine beschreibung :))
der user wird aufgefordert über einen eingeblendeten browser seine directory auszuwählen,in dieser werden nun nach auswahl dieser,alle dateien mit der endung .xls nacheinander geoeffnet und in dem angegebenen bereich der zur zeit ist "Worksheets(1).Columns("A:C")" alle "#" gegen " " ausgetauscht.
gruss nighty
noch eine beschreibung :))
der user wird aufgefordert über einen eingeblendeten browser seine directory auszuwählen,in dieser werden nun nach auswahl dieser,alle dateien mit der endung .xls nacheinander geoeffnet und in dem angegebenen bereich der zur zeit ist "Worksheets(1).Columns("A:C")" alle "#" gegen " " ausgetauscht.
gruss nighty
Antwort 6 von Jogi1976
Hallo Nighty !!
Danke für den genialen Code und die schnelle Antwort !!!
Ich hab da leider nur ein problem das er trotz der Änderung des Pfades und der Columns wo er nachschauen soll ; die Sheets nicht verändert werden .. :-((
woran kann das noch liegen ?? speichert er die Änderungen automatisch oder muss ich ihm noch sagen das er sie speichern soll bzw. einen anderen Pfad für die geänderten Sheets angeben ??
vielen Dank schon mal im vorhinein
lg.
Roman
Danke für den genialen Code und die schnelle Antwort !!!
Ich hab da leider nur ein problem das er trotz der Änderung des Pfades und der Columns wo er nachschauen soll ; die Sheets nicht verändert werden .. :-((
woran kann das noch liegen ?? speichert er die Änderungen automatisch oder muss ich ihm noch sagen das er sie speichern soll bzw. einen anderen Pfad für die geänderten Sheets angeben ??
vielen Dank schon mal im vorhinein
lg.
Roman
Antwort 7 von nighty
hi :)
hier bezieht sich die veränderung auf das erste sheet,daher per index die 1
statt A:C alternativ A:IV
Worksheets(1).Columns("A:IV").
fuer mehrere sheets wird eine schleife gefordert
gruss nighty
hier bezieht sich die veränderung auf das erste sheet,daher per index die 1
statt A:C alternativ A:IV
Worksheets(1).Columns("A:IV").
fuer mehrere sheets wird eine schleife gefordert
gruss nighty
Antwort 8 von Jogi1976
Hi nighty !
Jetzt steh ich ein bissi an ..
muss ich dafür das kompl. sub makro01() loopen
sprich ab hier ?? :
Sub makro01()
Dim i As Integer, letzte As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("C:\WINDOWS\Desktop\S L R\SLR Validierung\SlopeRatio\01 SLR_F8_98")
.SearchSubFolders = False
.FileName = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open FileName:=.FoundFiles(i)
Workbooks(2).Worksheets(1).Columns("A:O").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
gruss
Roman
Jetzt steh ich ein bissi an ..
muss ich dafür das kompl. sub makro01() loopen
sprich ab hier ?? :
Sub makro01()
Dim i As Integer, letzte As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("C:\WINDOWS\Desktop\S L R\SLR Validierung\SlopeRatio\01 SLR_F8_98")
.SearchSubFolders = False
.FileName = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open FileName:=.FoundFiles(i)
Workbooks(2).Worksheets(1).Columns("A:O").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
gruss
Roman
Antwort 9 von nighty
hi roman :)
du hattest recht korrigiert :))
und reicht das erste sheet ?
gruss nighty
makro01 jetzt korrigiert
Sub makro01()
Dim i As Integer, letzte As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Workbooks(2).Worksheets(1).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Workbooks(2).Save
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
du hattest recht korrigiert :))
und reicht das erste sheet ?
gruss nighty
makro01 jetzt korrigiert
Sub makro01()
Dim i As Integer, letzte As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Workbooks(2).Worksheets(1).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Workbooks(2).Save
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
Antwort 10 von nighty
hi roman :)
mit mehreren sheets dann so :))
makro01 ersetzen
gruss nighty
Sub makro01()
Dim i As Integer, letzte As Integer
Dim Tabellen As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
For Tabellen = 1 To Sheets.Count
Workbooks(2).Worksheets(Tabellen).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Next Tabellen
Workbooks(2).Save
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
mit mehreren sheets dann so :))
makro01 ersetzen
gruss nighty
Sub makro01()
Dim i As Integer, letzte As Integer
Dim Tabellen As Integer
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
For Tabellen = 1 To Sheets.Count
Workbooks(2).Worksheets(Tabellen).Columns("A:C").Replace _
what:="#", replacement:=" ", searchorder:=xlByColumns, MatchCase:=True
Next Tabellen
Workbooks(2).Save
Workbooks(2).Close
Next i
End If
End With
Application.DisplayAlerts = True
End Sub
Antwort 11 von Jogi1976
HI Nighty !!!
Schwerst genial !!!!!
funktioniert perfekt das makro und es hat gerade mehr als 350 dateien auf meiner festplatte verändert !!! :-))
Vielen Vielen DANK nochmals für deine Hilfe !!!!!!
glg.
Roman
Schwerst genial !!!!!
funktioniert perfekt das makro und es hat gerade mehr als 350 dateien auf meiner festplatte verändert !!! :-))
Vielen Vielen DANK nochmals für deine Hilfe !!!!!!
glg.
Roman
Antwort 12 von nighty
hi roman
:))
gruss nighty
:))
gruss nighty