Thema Datum  Von Nutzer Rating
Antwort
30.11.2015 16:34:11 Christy
Solved
30.11.2015 17:10:04 Gast33422
NotSolved
02.12.2015 18:48:08 Gast34486
NotSolved
01.12.2015 19:48:46 Gast7757
NotSolved
02.12.2015 18:46:28 Gast74363
NotSolved
02.12.2015 20:07:40 Gast17752
NotSolved
28.12.2015 14:28:41 Gast85905
NotSolved
28.12.2015 18:27:36 Gast36168
*****
NotSolved
28.12.2015 18:29:04 Gast64978
*****
NotSolved
29.12.2015 14:46:23 Christy
NotSolved
29.12.2015 23:08:42 Gast14895
NotSolved
30.12.2015 00:25:31 Christy
NotSolved
Rot Werte aus einem Sheet in ein anderes Worksheet suchen und ersetzen
30.12.2015 13:30:05 Gast30668
*****
NotSolved
30.12.2015 15:13:44 Christy
NotSolved
30.12.2015 15:32:00 Gast83878
NotSolved
30.12.2015 15:47:45 Christy
NotSolved
30.12.2015 16:03:49 Gast44293
NotSolved
30.12.2015 16:13:44 Christy
NotSolved
30.12.2015 16:25:29 Gast36885
NotSolved
30.12.2015 16:49:19 Christy
NotSolved
30.12.2015 17:34:04 Gast62394
NotSolved
30.12.2015 18:49:59 Christy
NotSolved
30.12.2015 19:23:30 Gast73856
NotSolved
30.12.2015 19:56:55 Christy
NotSolved
30.12.2015 19:34:02 Gast87846
NotSolved
30.12.2015 20:06:06 Christy
NotSolved
31.12.2015 12:24:53 Gast29201
NotSolved
01.01.2016 12:10:59 Gast58387
*****
NotSolved
01.01.2016 14:37:42 Gast94004
*****
NotSolved
01.01.2016 15:04:24 Gast28024
NotSolved
02.01.2016 15:11:36 Gast94933
NotSolved
02.01.2016 17:56:32 Gast96708
NotSolved
02.01.2016 18:59:46 Gast5675
*****
Solved
02.01.2016 23:38:36 Christy
NotSolved
03.01.2016 19:39:39 Gast96711
NotSolved
04.01.2016 21:12:58 Christy
NotSolved
04.01.2016 21:12:59 Christy
NotSolved
05.01.2016 10:11:16 Gast49661
NotSolved
05.01.2016 11:20:48 Christy
NotSolved
05.01.2016 11:27:10 Christy
NotSolved
05.01.2016 11:55:41 Gast29688
NotSolved
05.01.2016 13:00:29 Christy
NotSolved
06.01.2016 10:33:21 Gast15834
*****
NotSolved
06.01.2016 13:54:19 Christy
NotSolved
06.01.2016 16:39:54 Gast93769
*****
Solved
06.01.2016 19:53:36 Christy
NotSolved
06.01.2016 20:07:47 Gast83679
*****
Solved
06.01.2016 23:58:43 Christy
NotSolved
07.01.2016 00:04:03 Gast57954
NotSolved

Ansicht des Beitrags:
Von:
Gast30668
Datum:
30.12.2015 13:30:05
Views:
874
Rating: Antwort:
  Ja
Thema:
Werte aus einem Sheet in ein anderes Worksheet suchen und ersetzen

Hallo Christy ! Mal noch als Frage in Spalte C Datei2 kommen die Parameter immer vor oder kann da auch eine Zeile mit nur Text stehen, also ohne einen Parameter? Unten wäre der Code so wie oben gewünscht. Falls aber in C nur "Hallo" steht und in D ein Parameter ohne Wert, wird die Zeile auch gelöscht. Es bleiben also nur Zeile stehen, in denen was ersetzt wurde ( der Parameter war definiert)  oder wo kein Parameter gefunden wurden (weder in C noch in D). Du musst wieder deinen Pfad anpassen / eingeben. 

Bei meinem letzten Post war der Code übrigens nicht ganz richtig. Die Liste der zu löschenden Zeilen war nicht sortiert. Das führt ggf. beim Löschen zu ungewünschten Ergebnissen. Ist hier jetzt aber behoben.

Schonmal Guten Rutsch und viele Grüße

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 anzparameter As Long 'anzahl von versch. Parameter
Dim i As Long              'Variable zu zählen
Dim j As Long
Dim k As Long
Dim zeilen()
Dim letzter
Dim loschen As String
Dim temp As String
Dim loschen2
Dim posdav
Dim posakt
Dim gefunden As Boolean

'Application.ScreenUpdating = False

ReDim zeilen(0)
zeilen(0) = 0
loschen = ""

ziel = ThisWorkbook.Name
pfad = "     "     'noch anpassen
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"

quelle = "Datei2.xlsx"

If ActiveSheet.Cells(1, 1) <> "" Then       'wenn der erste Parameter fehlt nix machen
    anzparameter = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'schauen wieviel Parameter da sind
    Workbooks.Open Filename:=pfad & quelle
    For k = 3 To 4
    For i = anzparameter To 1 Step -1
        suche = Workbooks(ziel).Worksheets(1).Cells(i, 1).Value
        If suche <> "" Then
            
            ersetz = Workbooks(ziel).Worksheets(1).Cells(i, 5).Value
            With Workbooks(quelle).Worksheets(1).Columns(k)
            Set ergebnis = .Find(suche, LookIn:=xlValues)

            If Not ergebnis Is Nothing Then
                letzter = Application.WorksheetFunction.CountIf(Workbooks(quelle).Worksheets(1).Columns(k), "*" & suche & "*")
               
                For j = 1 To letzter
                    If ersetz = "" Then
                            
                            temp = Replace(loschen, ergebnis.Row & ";", "")
                            
                            If Len(temp) = Len(loschen) Then
                            
                                posdav = 1
                                posakt = InStr(posdav, loschen, ";")
                                gefunden = False

                                While posakt <> 0

                                If CLng(Mid(loschen, posdav, posakt - posdav)) > ergebnis.Row Then
   
                                    loschen = Left(loschen, posdav - 1) & ergebnis.Row & ";" & Right(loschen, Len(loschen) - posdav + 1)
    
                                    posakt = 0
                                    gefunden = True
                                Else
   
                                    posdav = posakt + 1
                                    posakt = InStr(posdav, loschen, ";")
                                End If

                                Wend
                                If gefunden = False Then loschen = loschen & ergebnis.Row & ";"

                            End If
  
                    Else
                        loschen = Replace(loschen, ergebnis.Row & ";", "")
                    
                        Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, k) = Replace(Workbooks(quelle).Worksheets(1).Cells(ergebnis.Row, k), suche, ersetz)
                    End If
                    Set ergebnis = .FindNext(ergebnis)
                Next j
                
             End If
   
            End With
            Set ergebnis = Nothing
          
        End If
    Next i
    Next k

     'jetzt löschen
     loschen2 = Split(loschen, ";")
     
     For j = UBound(loschen2) To 0 Step -1
        Workbooks(quelle).Worksheets(1).Rows(loschen2(j - 1)).Delete
     Next j

    Application.CutCopyMode = False
    Workbooks(ziel).Activate

    Workbooks(quelle).Close savechanges:=True
End If 'Code ausführung

Application.ScreenUpdating = True
End Sub


 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
30.11.2015 16:34:11 Christy
Solved
30.11.2015 17:10:04 Gast33422
NotSolved
02.12.2015 18:48:08 Gast34486
NotSolved
01.12.2015 19:48:46 Gast7757
NotSolved
02.12.2015 18:46:28 Gast74363
NotSolved
02.12.2015 20:07:40 Gast17752
NotSolved
28.12.2015 14:28:41 Gast85905
NotSolved
28.12.2015 18:27:36 Gast36168
*****
NotSolved
28.12.2015 18:29:04 Gast64978
*****
NotSolved
29.12.2015 14:46:23 Christy
NotSolved
29.12.2015 23:08:42 Gast14895
NotSolved
30.12.2015 00:25:31 Christy
NotSolved
Rot Werte aus einem Sheet in ein anderes Worksheet suchen und ersetzen
30.12.2015 13:30:05 Gast30668
*****
NotSolved
30.12.2015 15:13:44 Christy
NotSolved
30.12.2015 15:32:00 Gast83878
NotSolved
30.12.2015 15:47:45 Christy
NotSolved
30.12.2015 16:03:49 Gast44293
NotSolved
30.12.2015 16:13:44 Christy
NotSolved
30.12.2015 16:25:29 Gast36885
NotSolved
30.12.2015 16:49:19 Christy
NotSolved
30.12.2015 17:34:04 Gast62394
NotSolved
30.12.2015 18:49:59 Christy
NotSolved
30.12.2015 19:23:30 Gast73856
NotSolved
30.12.2015 19:56:55 Christy
NotSolved
30.12.2015 19:34:02 Gast87846
NotSolved
30.12.2015 20:06:06 Christy
NotSolved
31.12.2015 12:24:53 Gast29201
NotSolved
01.01.2016 12:10:59 Gast58387
*****
NotSolved
01.01.2016 14:37:42 Gast94004
*****
NotSolved
01.01.2016 15:04:24 Gast28024
NotSolved
02.01.2016 15:11:36 Gast94933
NotSolved
02.01.2016 17:56:32 Gast96708
NotSolved
02.01.2016 18:59:46 Gast5675
*****
Solved
02.01.2016 23:38:36 Christy
NotSolved
03.01.2016 19:39:39 Gast96711
NotSolved
04.01.2016 21:12:58 Christy
NotSolved
04.01.2016 21:12:59 Christy
NotSolved
05.01.2016 10:11:16 Gast49661
NotSolved
05.01.2016 11:20:48 Christy
NotSolved
05.01.2016 11:27:10 Christy
NotSolved
05.01.2016 11:55:41 Gast29688
NotSolved
05.01.2016 13:00:29 Christy
NotSolved
06.01.2016 10:33:21 Gast15834
*****
NotSolved
06.01.2016 13:54:19 Christy
NotSolved
06.01.2016 16:39:54 Gast93769
*****
Solved
06.01.2016 19:53:36 Christy
NotSolved
06.01.2016 20:07:47 Gast83679
*****
Solved
06.01.2016 23:58:43 Christy
NotSolved
07.01.2016 00:04:03 Gast57954
NotSolved