AW: Text ersetzen in vielen Excel-Dateien?
25.05.2020 08:29:15
fcs
Hallo Sergeij,
hier mein Vorschlag für ein entsprechendes Makro
LG
Franz
Sub Ersetzen()
Dim varFind, varReplace
Dim rngZelle As Range
Dim strDatei As String
Dim wkbAktiv As Workbook
Dim wkb As Workbook
Dim wks As Worksheet
Dim Statuscalc As Long
Set wkbAktiv = ActiveWorkbook
varFind = "DUS19" 'Suchtext
varReplace = "BRA08" 'Ersetzen-Text
If MsgBox("""" & varFind & """ ersetzen durch """ & varReplace & """", _
vbOKCancel, "Makro: Ersetzen") = vbCancel Then Exit Sub
On Error GoTo Fehler
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False
Statuscalc = .Calculation
.Calculation = xlCalculationManual
End With
'Zellen mit Dateinamen abarbeiten
For Each rngZelle In wkbAktiv.Worksheets("Daten").Range("A2:A30").Cells
strDatei = rngZelle.Text
'Prüfen, ob Zelle leer
If strDatei "" Then
'Prüfen, ob Datei vorhanden
If Dir(strDatei) "" Then
Set wkb = Application.Workbooks.Open(Filename:=strDatei, UpdateLinks:=False)
Set wks = wkb.Worksheets("Eingabe")
wks.UsedRange.Replace What:=varFind, Replacement:=varReplace, _
lookat:=xlPart, MatchCase:=True 'evtl. xlWhole statt xlPart
wkb.Close savechanges:=True
Resume_01:
Else
MsgBox "Datei " & vbLf & strDatei & vbLf & " nicht gefunden!"
End If
End If
Next
Fehler:
With Err
Select Case .Number
Case 0
Case 9 'Index-Fehler - Blatt Eingabe nicht vorhanden
wkb.Close savechanges:=False
Resume Resume_01
Case -2147352565 'Suchbegriff auf Blatt nicht vorhanden
wkb.Close savechanges:=False
Resume Resume_01
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Makro: Erstzen"
End Select
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = Statuscalc
End With
End Sub