Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1156to1160
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
Inhaltsverzeichnis

Doppelte Einträge mit VLookup

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

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

Betreff
Benutzer
Anzeige
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
Anzeige
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

Anzeige
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
Anzeige
Rückmeldung wäre nett gewesen ... (owT)
17.05.2010 16:13:11
Erich

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige