Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1760to1764
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Text ersetzen in vielen Excel-Dateien?

Text ersetzen in vielen Excel-Dateien?
25.05.2020 07:09:09
Sergej
Einnen wunderschönnen guten Morgen liebe Leute,
ich habe in der Tabelle "Daten" im Zellenbereich A2:A30 die Eintragungen von Exceldateien mit vollständigem Pfad stehen. Wie kann bitte ich folgendes per VBA erreichen:
Die Dateien sollen nacheinander geöffnet werden und nur im Arbeitsblatt "Eingabe" (sofern vorhanden) soll der Text DUS19 durch BRA08 geändert werden. Die Datei soll dann gespeichert werden. Dann die nächste Datei usw.
Herzlichen Dank im Voraus!
Besste Grüße,
Sergej

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Text ersetzen in vielen Excel-Dateien?
25.05.2020 08:07:25
Nepumuk
Hallo Sergej,
teste mal:
Option Explicit

Public Sub ReplaceText()
    Dim objCell As Range
    Dim objWorksheet As Worksheet
    Dim objWorkbook As Workbook
    For Each objCell In Worksheets("Daten").Range("A2:A30")
        If Not IsEmpty(objCell.Value) Then
            If Dir$(PathName:=objCell.Text) <> vbNullString Then
                Set objWorkbook = Workbooks.Open(Filename:=objCell.Text)
                For Each objWorksheet In objWorkbook.Worksheets
                    If objWorksheet.Name = "Eingabe" Then
                        Call objWorksheet.Cells.Replace(What:="DUS19", _
                            Replacement:="BRA08", LookAt:=xlWhole)
                        Exit For
                    End If
                Next
                Call objWorkbook.Close(SaveChanges:=True)
            End If
        End If
    Next
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
End Sub

Gruß
Nepumuk
Anzeige
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

Anzeige
AW: Text ersetzen in vielen Excel-Dateien?
25.05.2020 15:38:42
Sergej
Hallo Nepumuk , hallo Franz,
beides funktioniert. Vielen herzlichen Dank!
Eine Frage noch: Wie würde das Makro bitte aussehen, wenn ich in der aufgeführten Datenen (A2:A30) nur das Makro "transsheet" vor dem Speichern ausführen möchte?
Dieses Makro sollte in der Regel in alle Dateien vorhanden sein. Wenn nicht einfach für die betroffene Datei das Ausführen überspringen.
Beste Grüße,
Sergej
AW: Text ersetzen in vielen Excel-Dateien?
25.05.2020 16:53:11
Nepumuk
Hallo Sergej,
teste mal:
Option Explicit

Public Sub ReplaceText()
    Dim objCell As Range
    Dim objWorksheet As Worksheet
    Dim objWorkbook As Workbook
    For Each objCell In Worksheets("Daten").Range("A2:A30")
        If Not IsEmpty(objCell.Value) Then
            If Dir$(PathName:=objCell.Text) <> vbNullString Then
                Set objWorkbook = Workbooks.Open(Filename:=objCell.Text)
                For Each objWorksheet In objWorkbook.Worksheets
                    If objWorksheet.Name = "Eingabe" Then
                        Call objWorksheet.Cells.Replace(What:="DUS19", _
                            Replacement:="BRA08", LookAt:=xlWhole)
                        Exit For
                    End If
                Next
                On Error Resume Next
                Call Application.Run(Macro:=objWorkbook.Name & "!transsheet")
                On Error GoTo 0
                Call objWorkbook.Close(SaveChanges:=True)
            End If
        End If
    Next
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
End Sub

Gruß
Nepumuk
Anzeige
AW: Text ersetzen in vielen Excel-Dateien?
26.05.2020 10:02:45
Sergej
Vielen Dank - funktioniert perfekt.
Beste Grüße,
Sergej

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige