Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
376to380
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
376to380
376to380
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte vergleichen und ggf. ersetzen!

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
Anzeige
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
Anzeige
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
Gruß Sepp

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige