Excel VBA - Zeichenfolge für partielle Übereinstimmung mit automatischer Vervollständigung

Ich habe einige UserForm-Komboboxen, die für Teilübereinstimmungen eine automatische Vervollständigungsfunktion benötigen. Ich habe über 2000 Einträge und eine teilweise Übereinstimmung der Zeichenfolgen ist für Benutzer von grundlegender Bedeutung, um den richtigen Eintrag zu finden.

Ein praktisches Beispiel:

+------------------------+ | Food Market Groceries | +------------------------+ | Matt's Food Inc | +------------------------+ | Groceries for Mamas | +------------------------+ | Alabama Veggies Market |  +------------------------+ 

Wenn wir "ma" eingeben, sollten alle Optionen mit "ma" in der Dropdown-Liste erscheinen. In diesem Fall "Market", "Matt", "Alabama" und "Mamas".

Dies ist mein Formularcode. Es funktioniert gut, ich brauche nur eine zusätzliche ComboBox-Hilfe, um das Problem zu lösen. Der ComboBox-Bereich ist in den RowSource- Eigenschaften festgelegt und funktioniert auch einwandfrei .

Private Sub btnSubmit_Click()  Dim sheet As Worksheet Dim index As Long  Set sheet = ThisWorkbook.Sheets("Folha2")  'get last position index = LastRow(sheet) + 1  'insert the data sheet.Range("A" & index) = iniciaisTextBox.Value sheet.Range("B" & index) = ComboBox1.Value sheet.Range("C" & index) = TextBox1.Value sheet.Range("D" & index) = DTPicker1.Value sheet.Range("E" & index) = DTPicker2.Value sheet.Range("F" & index) = ComboBox2.Value sheet.Range("G" & index) = ComboBox3.Value sheet.Range("H" & index) = ComboBox4.Value sheet.Range("I" & index) = TextBox4.Value sheet.Range("J" & index) = TextBox5.Value sheet.Range("K" & index) = TextBox6.Value sheet.Range("L" & index) = TextBox7.Value sheet.Range("M" & index) = TextBox8.Value sheet.Range("N" & index) = ComboBox5.Value sheet.Range("O" & index) = TextBox9.Value sheet.Range("P" & index) = ComboBox6.Value sheet.Range("Q" & index) = ComboBox7.Value  'clear the form for new insert clearForm End Sub  Private Sub clearForm() Dim ctrl As Control On Error Resume Next For Each ctrl In Me.Controls If InStr(ctrl.Name, "DTPicker") > 0 Then ctrl.Value = Now Else ctrl.Value = "" End If Next ctrl On Error GoTo 0 End Sub    Private Function LastRow(sheet As Worksheet) Dim rng As Range Set rng = sheet.Cells LastRow = Last(1, rng) End Function  Private Function Last(choice As Long, rng As Range) Dim lrw As Long Dim lcol As Long  Select Case choice  Case 1: On Error Resume Next Last = rng.Find(What:="*", _ After:=rng.Cells(1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Select End Function 

Irgendwelche Gedanken?

Danke im Voraus.