COMBOBOX FÜLLEN (VBA - Unique) | HERBERS Excel Forum

Moin,
ich basteln an einer Möglichkeit eine ComboBox über eine Textbox (Volltext suche) zu füllen.
Die ComboBox bekomme ich auch gefüllt, allerdings, falls vorhanden mit teilweise doppelten Werte.
Habe schon viel Experimentiert, doch leider zerschiesse ich mir immer wieder alles
Ich denke das sollte eigentlich über die Funktion "WorksheetFunction.Unique" zu machen sein.
Ich habe allerdings keinen Plan wo ich diese in dem Code einbauen kann.
Anbei noch den Code und eine Beispielmappe
https://www.herber.de/bbs/user/157848.xlsm

Public Sub EintragSuchenNeu(Blatt As Worksheet, StartZeile As Integer, StartSpalte As Integer, SuchWort As MSForms.TextBox, Treffer As MSForms.ComboBox)
'
'    '------------------------------------------------------
'    'Nach Einträgen suchen
'    '------------------------------------------------------
'
    Blatt.Activate
    Treffer.Clear
    Dim i As Integer
    Dim Zelleneintrag As String
    Dim Eingabe As String
     i = StartZeile
       Eingabe = StrConv(SuchWort, vbUpperCase)
       Zelleneintrag = StrConv(Cells(i, StartSpalte).Value, vbUpperCase)
    Do While Cells(i, StartSpalte).Value > ""
     If InStr(Zelleneintrag, Eingabe) > 0 Then
         Treffer.AddItem Cells(i, StartSpalte).Value
       Else
     End If
            i = i + 1
            Zelleneintrag = StrConv(Cells(i, StartSpalte).Value, vbUpperCase)
    Loop
     If Treffer.ListCount > 0 Then
        Treffer.ListIndex = 0
     End If
End Sub

Für Hilfe wäre ich dankbar.
LG Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub EintragSuchenNeu(Blatt As Worksheet, StartZeile As Integer, StartSpalte As Integer, _ SuchWort As MSForms.TextBox, Treffer As MSForms.ComboBox) ' ' '------------------------------------------------------ ' 'Nach Einträgen suchen ' '------------------------------------------------------ ' Dim i As Integer Dim Zelleneintrag As String Dim Eingabe As String Dim objTreffer As Object Blatt.Activate Treffer.Clear Set objTreffer = CreateObject("scripting.dictionary") i = StartZeile Eingabe = StrConv(SuchWort, vbUpperCase) Zelleneintrag = StrConv(Cells(i, StartSpalte).Value, vbUpperCase) Do While Cells(i, StartSpalte).Value > "" If InStr(Zelleneintrag, Eingabe) > 0 Then objTreffer(Cells(i, StartSpalte).Value) = 0 End If i = i + 1 Zelleneintrag = StrConv(Cells(i, StartSpalte).Value, vbUpperCase) Loop If objTreffer.Count Then Treffer.List = objTreffer.keys Treffer.ListIndex = 0 End If End Sub

Hallo Daniel,
erstmal zu Deiner Frage : Ja und Nein :-)
Ich beschäftige mich intensiv mit VBA eigentlich erst seit Covid19 und helfe mir über die Runden mit der Copy/Paste Variante und etliche Stunden "Googeln".
Vom Prinzip ist ja alles eh nur Logik und Mathematik in der VBA Programmiersprache. (Welches mir leider fehlt)
Ich habe mir bereits einen Kunden an Land gezogen für einen GuV Statistik Auswertung, aber wie gesagt alles auf meinem "Wissensstand")
Aber es macht mir sehr viel Spaß und ich sehe welche Möglichkeiten man überhaupt hier hat, und habe bereits weitere Anfragen .
Eine große Hilfe hierbei ist dieses Forum und Helfer/Spezis. wie Du.(Daumen hoch!).
Mir fehlt einfach das gesamte Grundwissen, Bedeutung der Befehle,...usw.
Ich bin auch bereit, daß ganze von der Pike auf zu erlernen und denke an ein VBA Kurs bei der SGD. Dauert ca. 15 Monate, kann man aber auch abkürzen. Der ist aber halt sehr teuer.
Vielleicht kannst Du mir ja auch Alternativen (Außer nur Stundenlang (teilweise) nutzlose YouTube Videos zu schauen) vorschlagen.
Würde mich sehr freuen
Leute wie Du helfen ungemein Leuten wie mir, und ich hoffe ich kann das eines Tages hier im Forum zurückgeben
Ansonsten nochmals vielen Dank für Deinen Vorschlag
LG Frank

Public Sub EintragSuchenNeu(Blatt As Worksheet, StartZeile As Integer, StartSpalte As Integer, _ SuchWort As MSForms.TextBox, Treffer As MSForms.ComboBox) ' ' '------------------------------------------------------ ' 'Nach Einträgen suchen ' '------------------------------------------------------ ' Dim i As Integer Dim Zelleneintrag As String Dim Eingabe As String Dim strCBX As String Blatt.Activate Treffer.Clear Set objTreffer = CreateObject("scripting.dictionary") i = StartZeile Eingabe = StrConv(SuchWort, vbUpperCase) Zelleneintrag = StrConv(Cells(i, StartSpalte).Value, vbUpperCase) Do While Cells(i, StartSpalte).Value > "" If InStr(Zelleneintrag, Eingabe) > 0 Then If InStr(strCBX, "#" & Cells(i, StartSpalte)) = 0 Then strCBX = strCBX & "#" & Cells(i, StartSpalte) End If End If i = i + 1 Zelleneintrag = StrConv(Cells(i, StartSpalte).Value, vbUpperCase) Loop If Len(strCBX) Then Treffer.List = Split(strCBX, "#") Treffer.ListIndex = 0 End If End Sub

Public Function EintragSuchen(Blatt As Worksheet, StartZeile As Integer, StartSpalte As Integer, SuchWort As String) '------------------------------------------------------ 'Nach Einträgen suchen '------------------------------------------------------ Dim Dic Dim Elt Set Dic = CreateObject("scripting.dictionary") ' Wenn nur eine Spalte, aus einem zwei-dimensional Array einen ein-dimensional machen For Each Elt In Application.Transpose(Intersect(Cells(StartZeile, StartSpalte).CurrentRegion, Columns(StartSpalte)).Value) If InStr(1, Elt, SuchWort, vbTextCompare) Then Dic(LCase(Elt)) = Elt Next EintragSuchen = Dic.Items End Function Sub Test() Treffer.List = EintragSuchen(Worksheets("Tabelle1"), 1, 1, "Jan") 'Die Testeinträge haben "Jan 2022" bis "Dez 2023" (doppelt), liegen aber als Text vor (wichtig)! End Sub

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E
1	KUNDE001	KUNDE001	un	2	KUNDE001
2	KUNDE002	KUNDE002		2	KUNDE002
3	KUNDE002	RINDE004		#WERT!	HUNDE016
4	RINDE004	RINDE005		#WERT!	HUNDE018
5	RINDE005	RINDE006		#WERT!	HUNDE019
6	RINDE006	RINDE007		#WERT!	HUNDE020
7	RINDE007	RINDE009		#WERT!	HUNDE021
8	RINDE007	RINDE010		#WERT!	HUNDE022
9	RINDE009	RINDE011		#WERT!	HUNDE023
10	RINDE010	RINDE012		#WERT!	LUNTE024
11	RINDE011	RINDE013		#WERT!	LUNTE025
12	RINDE012	RINDE014		#WERT!	LUNTE026
13	RINDE013	RINDE015		#WERT!	LUNTE027
14	RINDE014	HUNDE016		2	LUNTE028
15	RINDE015	HUNDE018		2	LUNTE029
16	HUNDE016	HUNDE019		2	LUNTE030
17	HUNDE016	HUNDE020		2

Zelle	Formel
B1	=EINDEUTIG(A1:A30)
D1	=SUCHEN(C1;B1#)
E1	=FILTER(B1#;WENNFEHLER(SUCHEN(C1;B1#);0))

COMBOBOX FÜLLEN (VBA - Unique)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

COMBOBOX FÜLLEN (VBA - Unique)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread