|  
                                             
	Guten Morgen! 
	Also hier meine Variante. Wieder mit Kommentaren (ist aber mehr grün als neue Codezeilen geworden :-) ).  Falls du auch eine Version brauchst, wo die packagenamen in Blatt1 der Ausgangsdatei auch zeilenunabhängig stehen (also nicht nur in Ziel 75 bis 79) mal melden. Ansonsten kannst du bei einlesen der parameter, wo i mit der zeilennummer verglichen wird anpassen. Derzeit Gruß 
	  
Option Explicit
Sub ersetzen()
Dim ziel As String      'die Datei mit dem Code
Dim quelle As String    'die Datei in der ersetz wird
Dim pfad As String      'Pfad zur Datei in der ersetzt wird
Dim suche As String     'der Text der gesucht wird, PARAMETER
Dim ersetz              ' Wert die dann eingefügt werden , Spalte 3
Dim ergebnis As Object           'Rückgabewert des Ersetzen
Dim i As Long               'Variable zu zählen
Dim j As Long               'Variable zu zählen
Dim l As Long               'Variable zu zählen
Dim k As Long               'Variable zu zählen
Dim letzter                 'Anzahl der Vorkommen der parameter
Dim temp As String          'nimmt kurzzeitig die Parameter von Blatt 1 auf
Dim zeilen As Long          'die Anzahl der Zeile in denen gelöscht wird
Dim parameter() As String   ' nimmt alle Parameter + Werte dazu auf
Dim spalte As Long          ' die Spalte wo gesuch wird
Dim loschen() As Byte       ' Array für die Zeilen, hier wird mit 1 eingetragen, wenn gelöscht werden soll
Dim ende1 As Integer        ' Zeile der letzten Eintragungen Blatt 1
Dim ende2 As Integer        ' Zeile der letzten Eintragungen Blatt 1
'Änderungen nicht sichtbar machen - Bildschirm einfrieren
Application.ScreenUpdating = False
'Pfade Namen etc. festlegen
ziel = ThisWorkbook.Name
pfad = "   "     'noch anpassen
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
quelle = "Datei2.xlsx"  'x
'letzte gefüllte Zeile in Spalte A auf Blatt 1 und 2
ende1 = Workbooks(ziel).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ende2 = Workbooks(ziel).Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
'parameter dimensionieren, jetzt mit 8 zeilen
ReDim parameter(8, ende1)
parameter(1, 0) = 0
parameter(3, 0) = 0
parameter(5, 0) = 4
parameter(7, 0) = 0
'parameter aus blatt 1 auslesen
For i = 1 To ende1
    If Workbooks(ziel).Worksheets(1).Cells(i, 1) <> "" Then
    ' wenn zwischen A 75 bis 79 was steht dann in der else schleife die packages prüfen
    If i < 75 And i > 79 Then
        'Parameternamen auswerten
        temp = Workbooks(ziel).Worksheets(1).Cells(i, 1)
        If Len(temp) <> Len(Replace(temp, "pBUKRS", "")) Then
            'ein Parameter der Sorte pBUKRS%%
                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 ""
                    'leer sollte eigentlich nix mehr sein, aber man weiß ja nie
                
                Case Else
                    'die mit dem gleiche aufbau hatten wir schon, die 4 speziellen auch, bleiben nur die anderen
                    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
    'jetzt sind wir im Bereich der packages in Blatt 1
        'nur wenn rechts davon nein steht, die parameter prüfen
        If Workbooks(ziel).Worksheets(1).Cells(i, 2) = "nein" Then
            'jetzt mal alles packages in Blatt 2 prüfen
            For k = 1 To ende2
                'packagename in Blatt1 ist identisch mit dem in der Zelle in Blatt 2
                If Workbooks(ziel).Worksheets(1).Cells(i, 1) = Workbooks(ziel).Worksheets(2).Cells(k, 1) Then
                    'Anzahl der parameter in zeile 7 um ein erhöhenb
                    parameter(7, 0) = parameter(7, 0) + 1
                    'da wir aus Blatt 2 lesen könnten es ggf. mehr parameter als in der Dimensionierung sein, deshalb mal prüfen ob es noch passt
                    ' wenn nicht, dann die Dimension von parameter unter Beibehaltung der Einträge erhöhen.
                    If ende1 < parameter(7, 0) Then ReDim Preserve parameter(8, parameter(7, 0))
                    'Wert für den parameter zuweisen, wenn er nicht leer ist
                    If Workbooks(ziel).Worksheets(2).Cells(i, 2) <> "" Then parameter(7, parameter(7, 0)) = Workbooks(ziel).Worksheets(2).Cells(i, 2)
                End If
            Next k
        End If 'prüfung auf nein bei packages
    End If ' prüfung für bereich der package
    End If 'Prüfung leer
Next i
'datei öffnen
Workbooks.Open Filename:=pfad & quelle
'schauen wieviele Zellen beschrieben sind, gesucht wird in Spalte A, C und D
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
'loschen dimensionieren
ReDim loschen(zeilen)
For k = 1 To zeilen
    loschen(k) = 0
Next k
For k = 1 To 4
    'festlegen wo gesucht wird
    If k = 1 Or k = 2 Then
        spalte = 3
    ElseIf k = 3 Then
        spalte = 4
    Else
        'bei k = 4
        spalte = 1
    End If
    
    For l = parameter(2 * k - 1, 0) To 1 Step -1
        'Namen der parameter holen
        suche = parameter(2 * k - 1, l)
        If suche <> "" Then
            'Wert zum ersetzen holen
            ersetz = parameter(2 * k, l)
            
            With Workbooks(quelle).Worksheets(1).Columns(spalte)
            'suchen
            Set ergebnis = .Find(suche, LookIn:=xlValues)
            If Not ergebnis Is Nothing Then
                'wenn was gefunden, suchen wie oft das in der Spalte vorkommt
                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
                    ' löschen nur bei k =1 und k = 4
                        loschen(ergebnis.Row) = 1
                    Else
                        ' Werte ersetzen
                        Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte) = Replace(Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, spalte), suche, ersetz)
                    End If
                    'nächsten Wert finden
                    Set ergebnis = .FindNext(ergebnis)
                Next j
                
             End If
   
            End With
            Set ergebnis = Nothing
          
        End If 'Vergleich ob leer
    Next l
Next k
'jetzt löschen, dazu einfach alle Zeilen durchgehen und schauen ob eine 1 steht.
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
'schließeb mit speichern
Workbooks(quelle).Close savechanges:=True
'Änderungen sichtbar machen
Application.ScreenUpdating = True
End Sub
	  
     |