Option Explicit
Sub ersetzen()
Dim ziel As String
Dim quelle As String
Dim pfad As String
Dim suche As String
Dim ersetz
Dim ergebnis As Object
Dim i As Long
Dim j As Long
Dim l As Long
Dim k As Long
Dim letzter
Dim temp As String
Dim zeilen As Long
Dim parameter() As String
Dim spalte As Long
Dim loschen() As Byte
Application.ScreenUpdating = False
ziel = ThisWorkbook.Name
pfad = "C:\Users\ich\Desktop\Programmieung\hallo\Neuer Ordner"
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
quelle = "Datei2.xls"
ReDim loschen(0)
loschen(0) = 0
ReDim parameter(6, Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
parameter(1, 0) = 0
parameter(3, 0) = 0
parameter(5, 0) = 4
For i = 1 To Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
If Workbooks(ziel).Worksheets(1).Cells(i, 1) <> "" Then
temp = Workbooks(ziel).Worksheets(1).Cells(i, 1)
If Len(temp) <> Len(Replace(temp, "pBUKRS", "")) Then
parameter(1, 0) = parameter(1, 0) + 1
parameter(1, parameter(1, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 1)
parameter(2, parameter(1, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
Else
Select Case temp
Case "pBUDATto"
parameter(5, 1) = "pBUDATto"
parameter(6, 1) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
Case "pUDATEto"
parameter(5, 2) = "pUDATEto"
parameter(6, 2) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
Case "pZALDTto"
parameter(5, 3) = "pZALDTto"
parameter(6, 3) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
Case "pWADAT_ISTto"
parameter(5, 4) = "pWADAT_ISTto"
parameter(6, 4) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
Case ""
Case Else
parameter(3, 0) = parameter(3, 0) + 1
parameter(3, parameter(3, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 1)
parameter(4, parameter(3, 0)) = Workbooks(ziel).Worksheets(1).Cells(i, 5)
End Select
End If
End If
Next i
ziel = ThisWorkbook.Name
pfad = "C:\Users\ich\Desktop\Programmieung\hallo\Neuer Ordner"
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
quelle = "Datei2.xls"
Workbooks.Open Filename:=pfad & quelle
zeilen = Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 3).End(xlUp).Row
If zeilen < Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row Then zeilen = Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 4).End(xlUp).Row
ReDim loschen(zeilen)
For k = 1 To zeilen
loschen(k) = 0
Next k
For k = 1 To zeilen
loschen(k) = 0
Next k
For k = 1 To 3
For l = 1 To parameter(2 * k - 1, 0)
suche = parameter(2 * k - 1, l)
If suche <> "" Then
ersetz = parameter(2 * k, l)
If k = 1 Or k = 2 Then
spalte = 3
Else
spalte = 4
End If
With Workbooks(quelle).Worksheets(1).Columns(spalte)
Set ergebnis = .Find(suche, LookIn:=xlValues)
If Not ergebnis Is Nothing Then
letzter = Application.WorksheetFunction.CountIf(Workbooks(quelle).Worksheets(1).Columns(spalte), "*" & suche & "*")
For j = 1 To letzter
If ersetz = "" And k = 1 Then
loschen(0) = loschen(0) + 1
loschen(ergebnis.Row) = 1
Else
Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte) = Replace(Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte), suche, ersetz)
End If
Set ergebnis = .FindNext(ergebnis)
Next j
End If
End With
Set ergebnis = Nothing
End If
Next l
Next k
For j = UBound(loschen) To 1 Step -1
If loschen(j) = 1 Then Workbooks(quelle).Worksheets(1).Rows(j).Delete
Next j
Application.CutCopyMode = False
Workbooks(ziel).Activate
Workbooks(quelle).Close savechanges:=True
Application.ScreenUpdating = True
End Sub