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
Dim ende1 As Integer
Dim ende2 As Integer
Application.ScreenUpdating = False
ziel = ThisWorkbook.Name
pfad = " "
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
quelle = "Datei2.xlsx"
ende1 = Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ende2 = Workbooks(ziel).Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
ReDim parameter(8, ende1)
parameter(1, 0) = 0
parameter(3, 0) = 0
parameter(5, 0) = 4
parameter(7, 0) = 0
For i = 1 To ende1
If Workbooks(ziel).Worksheets(1).Cells(i, 1) <> "" Then
If i < 75 Or i > 79 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
Else
If Workbooks(ziel).Worksheets(1).Cells(i, 2) = "nein" Then
For k = 1 To ende2
If Workbooks(ziel).Worksheets(1).Cells(i, 1) = Workbooks(ziel).Worksheets(2).Cells(k, 1) Then
parameter(7, 0) = parameter(7, 0) + 1
If ende1 < parameter(7, 0) Then ReDim Preserve parameter(8, parameter(7, 0))
If Workbooks(ziel).Worksheets(2).Cells(k, 2) <> "" Then parameter(7, parameter(7, 0)) = Workbooks(ziel).Worksheets(2).Cells(k, 2)
End If
Next k
End If
End If
End If
Next i
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
If zeilen < Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row Then zeilen = Workbooks(quelle).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ReDim loschen(zeilen)
For k = 1 To zeilen
loschen(k) = 0
Next k
For k = 1 To 4
If k = 1 Or k = 2 Then
spalte = 3
ElseIf k = 3 Then
spalte = 4
Else
spalte = 1
End If
For l = parameter(2 * k - 1, 0) To 1 Step -1
suche = parameter(2 * k - 1, l)
If suche <> "" Then
ersetz = parameter(2 * k, l)
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) Or k = 4 Then
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