SVerweis2 von Ransi

Moderator: ModerationP

SVerweis2 von Ransi

Beitragvon john.eans » 24. Aug 2018, 18:15

Hallo zusammen,

hab im Netz die von Ransi geschriebene SVerweis2 Funktion für Excel gefunden. Ist im Prinzip genau das was ich schon lange suche, da ich so beim Verketten auf Bedingungen eingehen kann und gleichzeitig Duplikate ausschließen kann.
Leider funktioniert die Formel aber nur unter Windows. Hat jemand eine Idee, was man ändern kann, sodass die Formel auch bei Excel Mac funktioniert?

Public Function SVERWEIS2(Kriterium As String, _
Bereich As Range, _
SuchSpalte As Integer, _
ErgebnisSpalte As Integer, _
Optional Unikate As Boolean = True, _
Optional Trenner As String = ", ") As String
'***********************************************
'Autor: Ransi
'***********************************************
Dim arrTmp
Dim L As Long
Dim Mydic As Object
arrTmp = Bereich
Set Mydic = CreateObject("Scripting.Dictionary")
If Unikate = True Then
For L = 1 To UBound(arrTmp)
If arrTmp(L, SuchSpalte) = Kriterium Then Mydic(arrTmp(L, ErgebnisSpalte)) = 0
Next
SVERWEIS2 = Join(Mydic.keys, Trenner)
Else:
For L = 1 To UBound(arrTmp)
If arrTmp(L, SuchSpalte) = Kriterium Then Mydic(L) = arrTmp(L, ErgebnisSpalte)
Next
SVERWEIS2 = Join(Mydic.items, Trenner)
End If
End Function

Mfg und herzlichen Dank im Voraus

John
john.eans
 

Re: SVerweis2 von Ransi

Beitragvon Flotter Feger » 24. Aug 2018, 20:31

Hallo,

wenn du dir das Dictionary nicht selbst programmieren willst, musst du entweder auf die Unikate verzichten ...
Code: Alles auswählen
Public Function SVERWEIS3(Kriterium As String, Bereich As Range, SuchSpalte As Integer, ErgebnisSpalte As Integer, _
                          Optional Trenner As String 
= ", ") As String
Dim arrTmp
Dim L As Long

arrTmp 
= Bereich
For L 
= LBound(arrTmp) To UBound(arrTmp)
    If arrTmp(L, SuchSpalte) = Kriterium Then _
    If InStr
(1, SVERWEIS3, arrTmp(L, ErgebnisSpalte)) = 0 Then _
    SVERWEIS3 
= SVERWEIS3 & arrTmp(L, ErgebnisSpalte) & Trenner
Next
SVERWEIS3 
= Left(SVERWEIS3, Len(SVERWEIS3) - Len(Trenner))
End Function

... oder du googlest das nächste Mal besser ... ich hab keine 20 Sekunden gebraucht ... das Dictionary hat nämlich schon jemand nachgebaut ... speziell für den MAC !!! ... http://www.sysmod.com/Dictionary.cls

Wollte ich doch diesem Forum eine zweite Chance geben ... und schon der erste Post ist wieder genau das Gleiche ... :doubt:
VG Sabina

bei mir läuft Win 7 32-Bit - Office 2010 Pro Plus 32-Bit, Office 2016 Pro Plus 32-Bit und Office 2019 Pro Plus 32-Bit
Wer auch weiter Hilfe erwartet, sollte sich nicht zu schade sein, ein kurzes Feedback zu geben.
Benutzeravatar
Flotter Feger
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 2531
Registriert: 24. Okt 2016, 16:40

Re: SVerweis2 von Ransi

Beitragvon Gast » 24. Aug 2018, 22:00

Hallo,

besten Dank für den Code. So wie es aussieht reicht das erstmal vollkommen.

Hätte ich gewusst, nach was ich googlen muss, hätte ich sicherlich auch etwas gefunden. Aber danke für den Hinweis, wobei das Dictionary je nach Excel-Version mal funktioniert und mal nicht...hab es zumindest nicht zum laufen bekommen.
Auf dieser Seite https://stackoverflow.com/questions/198 ... ary-on-mac ist das Klassenmodul zwar als aktuellste Version vorhanden und vom Entwickler Patrick O'Beirne getestet, die von Ransi geschriebene Funktion spuckt aber leider auch damit nur das Ergebnis #WERT oder NULL aus.

Besten Dank für die schnelle Hilfe und einen schönen Abend!

LG
Gast
 

Re: SVerweis2 von Ransi

Beitragvon Flotter Feger » 24. Aug 2018, 22:44

Hallöchen Ich nochmal,

für MAC-User, die die Dictionary-Class aus einem der Links verwenden möchten ... ein Micro-Tutorial mit Download von mir.
Der Code läuft nun auch auf der Version 2016 für MAC !!!

Alles (in Englisch) nachzulesen auf: https://github.com/VBA-tools/VBA-Dictionary
Dateien sind zu finden auf: https://github.com/VBA-tools/VBA-Dictionary/releases

Die Datei entzippen und die Datei Dictionary.cls in Excel importieren.
VBA-Dictionary-1.4.1.zip

In der VBE auf die Tabellen-Module rechtsklicken und 'Datei importieren...' wählen. danach die CLS-Datei im Verzeichnisbaum auswählen und von Excel einlesen lassen.
Dann noch die Benutzung laut der Beschreibung im Code durchlesen ... und geniessen. :wink:

Oder einfach mal die Exceldatei im Ordner 'Specs' des Archives anschauen. :roll: Da hat der Autor noch ein paar kleine Kniffe und Tricks gelistet.

Eventuelle Fragen dazu, bitte im GitHub-Forum stellen ...

Codebeispiel für die Nutzung ... falls jemand noch nie mit dem Dictionary gearbeitet hat ... Benutzung exakt wie das Scripting.Dictionary in Windows.
Code: Alles auswählen
' (Works exactly like Scripting.Dictionary)'
Dim Dict As New Dictionary
Dict
.CompareMode = CompareMethod.TextCompare

Dict
("A") ' -> Empty'
Dict("A") = 123
Dict
("A") ' -> = Dict.Item("A") = 123'
Dict.Exists "A" ' -> True'

Dict.Add "A", 456
' -> Throws 457: This key is already associated with an element of this collection'

' Both Set and Let work'
Set Dict("B") = New Dictionary
Dict
("B").Add "Inner", "Value"
Dict("B")("Inner") ' -> "Value"'

UBound(Dict.Keys) ' -> 1'
UBound(Dict.Items) ' -> 1'

' Rename key'
Dict.Key("B") = "C"
Dict.Exists "B" ' -> False'
Dict("C")("Inner") ' -> "Value"'

' Trying to remove non-existant key throws 32811'
Dict.Remove "B"
' -> Throws 32811: Application-defined or object-defined error'

' Trying to change CompareMode when there are items in the Dictionary throws 5'
Dict.CompareMode = CompareMethod.BinaryCompare
' -> Throws 5: Invalid procedure call or argument'

Dict.Remove "A"
Dict.RemoveAll

Dict
.Exists "A" ' -> False'
Dict("C") ' -> Empty
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
VG Sabina

bei mir läuft Win 7 32-Bit - Office 2010 Pro Plus 32-Bit, Office 2016 Pro Plus 32-Bit und Office 2019 Pro Plus 32-Bit
Wer auch weiter Hilfe erwartet, sollte sich nicht zu schade sein, ein kurzes Feedback zu geben.
Benutzeravatar
Flotter Feger
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 2531
Registriert: 24. Okt 2016, 16:40


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 23 Gäste