Werte vergleichen und ggf. ersetzen!

Forumthread: Werte vergleichen und ggf. ersetzen!

05.02.2004 16:54:09

Franz

Hallo Excelprofis,
ich sitz mal wieder auf der Leitung :-)
Ich hab in einer Tabelle (Datei 1) zwei Spalten. In der Spalte C stehen alte Produktbezeichnungen drin und in der Spalte D stehen die (sofern diese vorhanden sind) die dazugehörigen neuen Produktbezeichnungen drin.
In einer anderen Exceldatei (Datei 2) stehen in Spalte A die Produktbezeichnungen (alt und neu gemischt).
Jetzt will ich, dass über ein Makro die Produktbezeichnungen der gemischten Tabelle mit den Spalten C und D der anderen Tabelle verglichen werden. Sobald nun ein alter Produktname in der Datei 2 gefunden wird und ein neuer Name (in Datei 1) dazu vorhanden is soll dieser durch den neuen Namen ersetzt werden. Ist kein neuer Name vorhanden, sollte der alte name in eine Art Fehlliste in der Datei 1 eingetragen werden.
Wie könnte der VBA Code aussehen!
Ich hoffe, dass ich mein Problem euch klar machen konnte!
Bin für jeden Tipp dankbar!
Gruß
Franz

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Werte vergleichen und ggf. ersetzen!

05.02.2004 18:33:40

Josef Ehrensberger
Vielen Dank genau das war's! o.T.

06.02.2004 11:53:15

Franz
Danke für die Rückmeldung! o.T.

06.02.2004 19:39:34

Josef Ehrensberger

AW: Werte vergleichen und ggf. ersetzen!

05.02.2004 18:33:40

Josef Ehrensberger

Hallo Franz!
Probier diesen Code mal aus.

Sub abgleichenNamen()
Dim wksAN As Worksheet  'Tabelle AltUndNeu
Dim wksE As Worksheet   'Tabelle mit Ersatznamen
Dim rngAN As Range      'Liste AltUndNeu
Dim rngE As Range       'Liste mit Ersatznamen
Dim rng As Range
Dim rFind As Range
Dim lngAN As Long
Dim lngE As Long
Dim lngL1 As Long
Dim lngL2 As Long
Set wksAN = Workbooks("Datei2.xls").Sheets("Tabelle1")
Set wksE = Workbooks("Datei1.xls").Sheets("Tabelle1")
lngAN = wksAN.Range("A65536").End(xlUp).Row
lngE = wksE.Range("C65536").End(xlUp).Row
lngL1 = 2
lngL2 = 2
wksE.Cells(1, 6) = "Name nicht vorhanden"
wksE.Cells(1, 7) = "Kein neuer Name vorhanden"
Set rngAN = wksAN.Range("A2:A" & lngAN)
Set rngE = wksE.Range("C2:D" & lngE)
For Each rng In rngAN
Set rFind = rngE.Find(What:=rng, LookIn:=xlValues, LookAt:=xlWhole)
If rFind Is Nothing Then
wksE.Cells(lngL1, 6) = rng
lngL1 = lngL1 + 1
Else
If rFind.Column = 3 And rFind.Offset(0, 1) <> "" Then
rng = rFind.Offset(0, 1)
ElseIf rFind.Column = 4 Then
wksE.Cells(lngL2, 7) = rng
lngL2 = lngL2 + 1
End If
End If
Next
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Werte vergleichen und ggf. ersetzen!

Forumthread: Werte vergleichen und ggf. ersetzen!

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread