SVERWEIS mit 2 Kriterien

Hallo Claus,

Für mein Verständnis würde mich abschließend noch der alleinstehende SVERWEIS mit den 2 Kriterien und der vorangestellten ZÄHLENWENN Abfrage für meinen Fall interessieren ohne die Sonderbedingungen auszuwerten. Wie würde dafür die Makroformel lauten?

myval=...

Gruß Matthias

Danke dir für deinen Code. Habe ihn in mein Sheet implementiert. Irgendwie klappt es mit der marierung in der Spalte AD nich so ganz. Ich bekomme zwar die Werte die Ich in HT_zusammenfassung definiert habe. Jedoch nicht bei den richtigen Zeilen...

Kein Dings, aber was passiert wenn Du 2 Ergebnisse für eine Zeile hast?

Andreas.

Sub Kriteriendef_zusammenfassung_AK()

Dim Data1, Data2

Dim i As Long, k As Long

With Sheets("Tabelle1")

'Max. Anzahl Zeilen

k = Range("B" & Rows.Count).End(xlUp).Row

'Daten einlesen

Data1 = WorksheetFunction.VLookup(.Range("N2:N" & k), _

Sheets("HT_Zusammenfassung").[A2:B20], 2, False)

Data2 = WorksheetFunction.VLookup(.Range("B2:B" & k), _

Sheets("HT_Zusammenfassung").[D2:E20], 2, False)

'Durchlaufe das Array zeilenweise

For i = 1 To UBound(Data1)

'Ist ein Fehler in der ersten Spalte?

If IsError(Data1(i, 1)) Then

If IsError(Data2(i, 1)) Then

'Nichts gefunden, dann leer

Data1(i, 1) = Empty

Else

'Daten aus dem 2ten Array übertragen

Data1(i, 1) = Data2(i, 1)

End If

Else

'Ggf. beide Daten eintragen

If Not IsError(Data2(i, 1)) Then _

Data1(i, 1) = Data1(i, 1) & ", " & Data2(i, 1)

End If

Next

'Das Ergebnis in die Spalte eintragen

.Range("ad2").Resize(UBound(Data1), 1) = Data1

End With

End Sub

Hi Andreas

Das mit den zwei Egebnissen pro Zeile kommt nicht vor.

Script läuft Perfekt.

Lieben Dank.

Gruss Thom



PS: schöne Ferien

Hallo Andreas

Danke dir für deinen Code. Habe ihn in mein Sheet implementiert. Irgendwie klappt es mit der marierung in der Spalte AD nich so ganz. Ich bekomme zwar die Werte die Ich in HT_zusammenfassung definiert habe. Jedoch nicht bei den richtigen Zeilen...

http://www.conzeptx.ch/TLOG/

hier habe ich eine Testdatei hochgeladen. Wenn du trotz deinen Ferien Zeit hast diese mal anzuschauen. Ist einfacher als alles genau zu beschreiben. Die gelb und blau markierten Zeilen müssten eine 1 oder eine 2 in Spalte ad haben.

Danke im Voraus und ich wünsche noch schöne Ferien.

;-) Gruss Thom

PS: dass mit dem Wert Kein #NV ist so gewollt. (wennistNV dann "")

Tja, so gar nicht, allerspätestens hier sind Formeln am Ende der Fahnenstange.

BTW, Formeln in VBA zu verwenden ist zwar bequem, tritt allerdings ein Fehler auf, dann funktioniert hier nichts mehr und man fummelt sich die Finger wund bis man das Problem lokalisiert hat. Und oft kann man dann noch nicht mal was dagegen machen das es
nicht wieder auftritt.

Ein bißchen komisch ist die Verwendung von SpecialCells, denn dadurch entstehen theoretisch Lücken in der Datenreihe, weil die Fehlerwerte entfernt und nicht die Zeilen gelöscht werden.

Daher wäre eine Frage wäre ob die Ergebnisse vereinigt werden sollen, sprich vorhandene Lücken auffüllen? Aber was ist dann wenn wir doppelte Werte haben?

Tja, ich hab mich einfach mal für die Möglichkeit entschieden die Ergebnisse untereinander zu kopieren und dabei Fehlerreihen richtig zu löschen, d.h. es kommen keine Lücken mehr vor.

Ob das so alles in Deinem Sinne ist...

Andreas.

PS. Ich habe ab jetzt eine Woche Urlaub, daher wird eine Antwort etwas dauern, falls Du Fragen hast.

Sub Kriteriendef_zusammenfassung_AK()

Dim Data(1 To 2), Result()

Dim i As Long, j As Long, k As Long

With Sheets("Tabelle1")

'Daten einlesen

Data(1) = WorksheetFunction.VLookup(.[n2:n4000], _

Sheets("HT_Zusammenfassung").[A2:B20], 2, False)

Data(2) = WorksheetFunction.VLookup(.[b2:b4000], _

Sheets("HT_Zusammenfassung").[d2:e20], 2, False)

'Platz für theoretisch max. Ausgabe reservieren

' Anm.: Ich benutze die 2. Dimension, weil wir nur diese später kleiner machen können.

' Dieser Bereich ist IMHO viel zu groß, da je SVERWEIS nur max. 19 Werte geliefert _

werden können!?

' Ich bin mir da nicht sicher, daher benutze ich den zurückgegebenen Bereich, dieser _

umfasst je 3999 Zeilen.

ReDim Result(1 To 1, 1 To UBound(Data(1)) + UBound(Data(2)))

'Durchlaufe beide Daten

For j = 1 To 2

'Durchlaufe das Array zeilenweise

For i = 1 To UBound(Data(j))

'Ist ein Fehler in der ersten Spalte?

If Not IsError(Data(j)(i, 1)) Then

'Nein, den Wert übertragen

k = k + 1

Result(1, k) = Data(j)(i, 1)

End If

Next

Next

'Haben wir was gefunden?

If k > 0 Then

With .Range("ad2")

'Ein ggf. vorheriges Ergebnis löschen

' Anm.: Dies löscht $AD$2:$AD$7999

.Resize(UBound(Result, 2), 1).ClearContents

'Den Überschuß entfernen

ReDim Preserve Result(1 To 1, 1 To k)

'Das Ergebnis in die Spalte eintragen

.Resize(k, 1) = WorksheetFunction.Transpose(Result)

End With

End If

End With

End Sub