Doppelte Einträge mit VLookup

Forumthread: Doppelte Einträge mit VLookup

Micha

Hallo Leute,
ich nutze die Funktion "VLookup" in einer Schleife.


Cells(iCount, 9).Value = Application.WorksheetFunction.VLookup(Cells(iCount, 2), Worksheets(" _
Tab").Range("A1:F2000"), 4, False)

Das Problem ist, dass mit dieser Schleife auch Einträge doppelt auftreten.
Wie verhindere ich solche doppelten Einträge?
Hintergrund:
Ich habe in dem Workshit "Tab" 2 Spalten: Abkürzung und Beschreibung. In dem zweiten Worksheet "Tab2" habe ich die genutzten Abkürzungen in Spalte A stehen und möchte zu diesen die Beschreibung aus "Tab" Spalt B á la SVERWEIS().
Danke für eure Hilfe
Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Wo sind die Dubletten?

12.05.2010 15:39:01

Erich

Hi Micha,
obwohl du den Hintergrund beschrieben hast, verstehe ich nicht, was getan werden soll.
Wo treten Einträge doppelt auf - in Spalte 2 (Tab2) oder - nach Ausführung des VLookup - in Spalte 9?
(Ich beziehe mich auf die Spalten in der Codezeile - die passen nicht wirklich zu denen des "Hintergrunds".)
Wenn zweimal der selbe Begriff in Spalte B steht, würde Spalte I identisch ermittelt.
Dann würde ich aber - vielleicht vor der Schleife - die Dubletten in Spalte B eliminieren.
Was soll passieren, wenn eine Dublette gefunden wird ("Löschen" ist so vieldeutig...):
Delete (der ganzen Zeile?) oder nur Clear oder ClearContents?
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Doppelte Einträge mit VLookup

12.05.2010 15:48:18

fcs

Hallo Micha,
wie Erich schon schrieb, deine Prozedur passt irgendwie noch garnicht zu deiner Beschreibung.
Deine Prozedur sucht für die Werte, die in Spalte 2 des aktiven Blatts stehen, die Zeile in Spalte A im Blatt "Tab" mit dem Wert und trägt als Ergebnis den Wert aus Spalte D der Zeile in die Spalte I (9) des aktiven Blatts ein.
VLookup macht in Makros probleme, wenn der Suchwert eine leere Zelle ist oder wenn der zu suchende Wert in der Liste fehlt. Deshalb verwende ich meistens die Find-Methode statt VLookup.
Gruß
Franz

Sub aaTest()
Dim iCount As Long
Dim Zelle As Range
For iCount = 2 To 14
'Suche zum Wert in Spalte A (1) des aktiven Blattes im Blatt "Tab" die Zeile in _
Spalte A(Abkürzung) und trage aus der 2. Spalte (B) des Bereichs die Beschreibung _
als Ergebnis in Spalte I (9) ein
If IsEmpty(Cells(iCount, 1)) Then
Cells(iCount, 9).ClearContents
Else
Cells(iCount, 9).Value = Application.WorksheetFunction.VLookup(Cells(iCount, 1), _
Worksheets("Tab").Range("A1:F2000"), 2, False)
End If
'Alternative - weniger fehleranfällig
If IsEmpty(Cells(iCount, 1)) Then
Cells(iCount, 9).ClearContents
Else
With Worksheets("Tab")
Set Zelle = .Columns(1).Find(What:=Cells(iCount, 1).Value, LookIn:=xlValues, Lookat:= _
xlWhole)
End With
If Zelle Is Nothing Then
Cells(iCount, 9) = "#FEHLER#"
Else
Cells(iCount, 9) = Zelle.Offset(0, 1).Value
End If
End If
Next
End Sub

Codevorschlag

12.05.2010 17:57:29

Erich

Hi Micha,
da ich das einfach mal ausprobieren wollte, ´hab ich VOR deiner Antwort mal einen Code geschrieben.
Ob er das tut, was du möchtest, weiß ich nicht. Du kannst es ausprobieren...


Option Explicit
Sub AbkUeber()
Dim lngT As Long, arrT, lngA As Long, arrQ, arrE1(), arrE2()
Dim ii As Long, varV, lngN As Long, zz As Long
Const lngKurz As Long = 2, lngLang As Long = 9     ' Quell- und Zielspalte
With Worksheets("Tab")        ' in "Tab" Abk. in Spalte A, Beschr. in Spalte B
lngT = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 ' Abk.-Tabelle einlesen
arrT = .Cells(2, 1).Resize(lngT, 2)             '  (1 Zeile Überschrift)
End With
lngA = Cells(Rows.Count, lngKurz).End(xlUp).Row
arrQ = Application.Transpose(Cells(2, lngKurz).Resize(lngA))
ReDim arrE1(1 To lngA), arrE2(1 To lngA)
For ii = 1 To lngA
If IsEmpty(arrQ(ii)) Then                 ' leere Zelle
ElseIf UCase(arrQ(ii)) = varV Then        ' Dublette
Else
lngN = lngN + 1                        ' neue Ausgabezeile
varV = UCase(arrQ(ii))
arrE1(lngN) = arrQ(ii)                 ' Eintrag Quellspalte (Abk.)
For zz = 1 To lngT
If varV = UCase(arrT(zz, 1)) Then
arrE2(lngN) = arrT(zz, 2)        ' Eintrag Zielspalte (Beschr.)
Exit For
End If
Next zz
End If
Next ii
If lngN > 0 Then                                                  ' Ausgabe
Cells(2, lngKurz).Resize(lngN) = Application.Transpose(arrE1)
Cells(2, lngLang).Resize(lngN) = Application.Transpose(arrE2)
If lngN + 1

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Rückmeldung wäre nett gewesen ... (owT)

17.05.2010 16:13:11

Erich

Beliebteste Forumthreads (12 Monate)

Forumthread: Doppelte Einträge mit VLookup

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Doppelte Einträge mit VLookup

Forumthread: Doppelte Einträge mit VLookup

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread