Zelle über if funktion ersetzen

[Noob55]

Hallo zusammen,

ich bin noch ein ziemlicher VBA Anfänger und komme einfach nicht weiter. Ich habe schon ewig rumgegoogelt bin aber auf nichts gestoßen, was meiner Herausforderung ähnelt:

Insgesamt wird in 2 Workbooks gearbeitet. (Im Grunde mehr aber ich will niemanden verwirren :20: )

In Workbook 1 werden Begriffe gesucht welche ersetzt werden müssen.

Workbook 2 beinhaltet eine Übersetzungsliste. Alle Begriffe, die in Spalte A vorkommen, müssen und mit der Nachbarzelle aus Spalte B ersetzt werden.
Funktionstechnisch ausgedrückt also folgendermaßen:

Wenn workbook2!A1 in Workbook1 gefunden wird 
dann diese Zelle durch Workbook2!B1 ersetzen,
ansonsten 
wenn (Workbook2!A2 in Workbook1 gefunden wird
dann diese Zelle durch Workbook2!B2 ersetzen.
ansonsten
wenn (Workbook2!A3 in Workbook1 gefunden wird
dann diese Zelle durch Workbook2!B3 ersetzen)...

usw. für 2700 Zeilen

Bisher habe ich folgenden Code (nur ein Teilcode):

Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets  ' ActiveWorkbook ist Workbook1

    wks.Cells.Replace What:=Workbooks("Workbook2.xlsx").Sheets("Tabelle1).Range("A2").Value, Replacement:=Workbooks("Workbook2.xlsx").Sheets("Tabelle1).Range("B2").Value, LookAt:= _
    xlPart, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next

Hierbei wird aber nur nach a2 "gesucht" (im Grunde ist es keine direkte Suche).
Benötigt wird es für die gesamte Spalte.

Ich denke mit einer For Schleife oder einem Counter wäre mir geholfen. Ich weis allerdings nicht wie ich das ganze aufziehen soll.

Ich danke für jede hilfreiche Anregung!

[Gast 123]

Hallo

wurde der Original Code schon mal getestet?? Ich hatte eine rot markierte Zeil, Syntaxfehler!! Das " Zeichen fehlt bei Sheets("Tabelle1) am Schluss!

Weiterhin gebe ich zu bedenken das Replace durch wks.Cells aufs ganze Blatt wirkt, auf alle Spalten, und auf xlPart eingestellt ist.  Da werden auch konsequent im ganzen Blatt alle Teile im Text ausgetauscht, die übereinstimmen! Das kann m.E. so sicher nicht richtig sein. Excel ist da konsequent! 

Probier den unteren Code bitte mal in einem Test Ordner,  bitte NICHT direkt mit den Original Dateien!!  Ich weiss nicht ob er auf Anhieb klappt, oder versehentlich was falsches austauscht? Ich konnte ihn bei mir nicht testen. Mein Code setzt voraus dass das Makro sich in Workbook1 = ThisWorkbook befindet. Sonst klappt es nicht!

mfg Gast 123 

Code:

Sub Zelle_ersetzen()
Dim AC As Range, lz1 As Long
Dim OldWert As Variant
Dim NewWert As Variant
Dim wks As Worksheet

'zuerst LastZell in Workbook1 = This Workbook suchen!!
lz1 = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row

For Each wks In ActiveWorkbook.Worksheets  ' ActiveWorkbook ist Workbook1
  If wks.Name <> ThisWorkbook.Name Then   'Workbook1 = This Workbook!!
     For Each AC In ThisWorkbook.Sheets("Tabelle1").Range("A2:A" & lz1)
        'Workbook1 Soalte A mit Workbook2 Spalte B vrgleichen
         OldWert = wks.Sheets("Tabelle1").Cells(AC.Row, 1).Value
         OldWert = wks.Sheets("Tabelle1").Cells(AC.Row, 2).Value
         'alten Wert in A gegen neuen Wert in B austauschen
         If AC.Value = OldWert Then AC.Value = NewWert
     Next AC
  End If
Next
End Sub

---

Nachtrag   Alle Mappen müssen zum Vergleichen geöffnet sein! Das ist in dem Makro nicht vorgesehen!

[Kuwer]

Hallo,

Sub abc()

  Dim i As Long

  Dim varLookup As Variant

  Dim wks As Worksheet



  varLookup = Workbooks("Mappe2").Worksheets("Tabelle1").Cells(1).CurrentRegion.Value

  

  For Each wks In ActiveWorkbook.Worksheets  ' ActiveWorkbook ist Workbook1

    For i = 2 To UBound(varLookup)

      wks.Cells.Replace What:=varLookup(i, 1), Replacement:=varLookup(i, 2), _

        LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Next i

  Next wks

End Sub

Gruß Uwe

[Noob55]

Vielen Dank! Bitte meinen Beitrag nicht vergessen ich habe noch einige Fragen an dich und deinen Code, kann heute allerdings nicht mehr antworten.

Ich melde mich morgen bei dir.

---

Vielen Dank auch an dich uwe.

Könntest du mir erklären, was die Funktion VarLookUp hier in dem Fall genau macht?
Du hast deine Range festgelegt mit "Cells (1)". Wird hierbei eine bestimmte Zelle angesprochen oder muss ich das in Verbindung bringen mit CurrentRegion? Woher weis ich dass die Richtige Zelle in meiner Übersetzungstabelle gesucht wird?

Tut mir Leid, dass ich so viele Nachfragen stelle aber ich würde gerne nicht nur stumpf copy paste Codes einfügen, sondern auch verstehen, was ich da mache. Schließlich will man was dazulernen:)

[Noob55]

Guten Morgen Gast123,

Es handelt sich darum, dass ein neuer Standard zur Dokumentenbezeichnung eingeführt wird. Hierzu müssen alle Alt-Dokumentenbezeichnungen ersetzt werden durch die neue Bezeichnung. Es soll also tatsächlich alles geändert werden.
Der Code befindet sich in einer eigenen Makro-Datei und ist unabhängig von den zu bearbeitenden Dateien dementsprechend funktioniert dein Code bei mir leider nicht.

---

Guten Morgen Uwe,

dein Code funktioniert richtig gut  :18: ...
Allerdings sucht der Code alle Zellen ab. Ich habe leider vergessen zu erwähnen, dass auch Kopf- und Fußzeile abgesucht werden müssen.
Ich habe es mit wks.leftheader.replace versucht, da hat der aber rumgemeckert. Kriegt man das mit replace noch hin oder muss ich zusätzlich zu wks.CellsReplace noch eine andere Funktion verwenden?

[Kuwer]

Hallo,

mit Kopf- und Fußzeile so:

Sub abc()

  Dim i As Long

  Dim varLookup As Variant

  Dim wks As Worksheet



  varLookup = Workbooks("Mappe2").Worksheets("Tabelle1").Cells(1).CurrentRegion.Value

  

  Application.PrintCommunication = False  'ab E2010 dient zur Codebeschleunigung

  For Each wks In ActiveWorkbook.Worksheets  ' ActiveWorkbook ist Workbook1

    For i = 2 To UBound(varLookup)

      wks.Cells.Replace What:=varLookup(i, 1), Replacement:=varLookup(i, 2), _

        LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

      With wks.PageSetup

        .LeftHeader = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

        .CenterHeader = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

        .RightHeader = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

        .LeftFooter = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

        .CenterFooter = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

        .RightFooter = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

      End With

    Next i

  Next wks

  Application.PrintCommunication = True

End Sub

Gruß Uwe

[Noob55]

Hallo Uwe,

zunächst einmal vielen Dank für deine schnelle Reaktion. 
Der neue Code funktioniert leider nicht so richtig. Zunächst einmal läuft die Sache sehr langsam, sodass ich beispielhaft nur eine neue Zeile übernommen habe:
wks.PageSetup.CenterFooter = Replace(wks.PageSetup.CenterFooter, varLookUp(i, 1), varLookUp(i, 2))

Leider verändert sich das zu ersetzende Begriff nicht. Es wird nur eine 1 im ersten Worksheet und eine 2 im zweiten Worksheet eingefügt.
Ich habe noch ein Screenshot angehangen wie es aussieht.

Ilyas

[Kuwer]

Hallo Ilyas,

meine Recherchen und Tests ergaben, dass das "PrintCommunication = False" fehlerhafte Ergebnisse liefert.
Um den Code trotzdem zu beschleunigen, sollte temporär auf einen lokalen Drucker umgestellt werden. Ich habe es bei mir mit dem "Microsoft XPS Document Writer" getestet.
Es erscheint jetzt ein Dialog zur Druckerauswahl, in dem auf keinen Fall ein Netzwerkdrucker ausgewählt werden sollte, wenn nicht eine längere Pause geplant ist.
Am Ende des Codes wird automatisch wieder der vorher eingestellte Drucker aktiviert. Übernimm folgenden Code bitte erst einmal komplett, da noch weitere Fehler beseitigt wurden.

Sub abc()

  Dim i As Long

  Dim strAP As String

  Dim varLookup As Variant

  Dim wks As Worksheet



  varLookup = Workbooks("Mappe2").Worksheets("Tabelle1").Cells(1).CurrentRegion.Value

  

  strAP = Application.ActivePrinter

  Application.Dialogs(xlDialogPrinterSetup).Show

  For Each wks In ActiveWorkbook.Worksheets  ' ActiveWorkbook ist Workbook1

    For i = 2 To UBound(varLookup)

      wks.Cells.Replace What:=varLookup(i, 1), Replacement:=varLookup(i, 2), _

        LookAt:=xlPart, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

      With wks.PageSetup

        .LeftHeader = Replace(.LeftHeader, varLookup(i, 1), varLookup(i, 2))

        .CenterHeader = Replace(.CenterHeader, varLookup(i, 1), varLookup(i, 2))

        .RightHeader = Replace(.RightHeader, varLookup(i, 1), varLookup(i, 2))

        .LeftFooter = Replace(.LeftFooter, varLookup(i, 1), varLookup(i, 2))

        .CenterFooter = Replace(.CenterFooter, varLookup(i, 1), varLookup(i, 2))

        .RightFooter = Replace(.RightFooter, varLookup(i, 1), varLookup(i, 2))

      End With

    Next i

  Next wks

  Application.ActivePrinter = strAP

End Sub

Gruß Uwe

[Noob55]

Uwe du bist ja echt der Boss aber leider will das ganze nicht funktionieren.

Beim ersten Versuch wurden die Kopfzeilen zwar verändert nur ist mir danach mein Excel abgestürzt.
Beim zweiten versuch wurde nichts verändert und mein Excel ist wieder abgestürzt.
Gibt es eine Möglichkeit aussser Application.PrintCommunication = False und der Druckergeschichte, dass das ganze beschleunigt wird.

By the Way: das soll nur ein Teil Code sein

Sub Dateien_nacheinander_oeffnen()
    Dim cDir As String
    Dim sPath As String
   
    sPath = "C:\Users\ilyas\Desktop\Test\"
    cDir = Dir(sPath & "*.xlsx" & "*.xls" & "*xlsm")
   
    Do While cDir <> ""
        Workbooks.Open (sPath & cDir)
        'aenderungen im Worksheet vornehmen
       
  Hier soll Uwes Code rein. 

        ActiveWorkbook.SaveAs "C:\Users\ilyabidi\Desktop\Test\" & cDir
        ActiveWorkbook.Close False
       
        'naechste Datei lesen
        cDir = Dir
    Loop
End Sub
 

Insgesamt werden 2700 Dateien geöffnet und geschlossen. Das wird mir alles um die Ohren fliegen...

Bin ich ein hoffnungsloser Fall oder kann man das doch irgendwie lösen?


Mit kullernden Augen
Ilyas

[Kuwer]

Hallo Ilyas,

werden die Dateien tatsächlich in einem anderen Userprofil zurückgespeichert oder ist das ein Schreibfehler?

Gruß Uwe