Entfernen Sie doppelte Formular-Combobox

Question

Ich arbeite an einem Blatt, das tägliche Verkaufsdaten haben. Ich muss die Daten zwischen einem bestimmten Datum zusammenfassen. Dazu möchte ich ein Benutzerformular mit 2 Kombinationsfeld verwenden (Ich habe noch nie zuvor mit Benutzerformularen & Kontrollen gearbeitet). Ich fügte die Einzelteile in Kombinationsfeld hinzu, indem ich unten Codes verwendete -

Private Sub UserForm_Initialize() 
ComboBox1.RowSource = "A2:A6724" 
ComboBox2.RowSource = "A2:A6724" 
End Sub 

dieses funktionierte gut. Aber hier ist ein Problem, dass es die gleichen Elemente viele Male wiederholt, da es viele Transaktionen in demselben Datum im Blatt gibt.

Um dieses Problem zu lösen suche ich Hilfe im Internet & fand eine Prozedur, die ich modifiziere und in meinem Code verwendet. das funktioniert richtig, aber es hat auch ein kleines Problem, dass, wenn ich auf ein Datum aus der Dropdownliste des Kombinationsfelds klicke, das Datumsformat ändert (dh wenn ich 10/12/2016 auswähle zeigt es 12-okt-2016 aber es sollte sein 10-Dec-2016) hier ist der Code modifizieren ich eigentlich weiß ich nicht, was es tut, aber ich denke, arbeiten ist für me-

Private Sub UserForm_Initialize() 
'ComboBox1.RowSource = "A2:A6724" 
'ComboBox2.RowSource = "A2:A6724" 
Dim Coll As Collection, cell As Range, LastRow As Long 
Dim blnUnsorted As Boolean, i As Integer, temp As Variant 
Dim SourceSheet As Worksheet 
Set SourceSheet = Worksheets("Sheet1") 
LastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row 
On Error Resume Next 
Set Coll = New Collection 
With ComboBox1 
.Clear 
For Each cell In SourceSheet.Range("A2:A" & LastRow) 
If Len(cell.Value) <> 0 Then 
Err.Clear 
Coll.Add cell.Text, cell.Text 
If Err.Number = 0 Then .AddItem cell.Text 
End If 
Next cell 
End With 
Set SourceSheet = Worksheets("Sheet1") 
LastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row 
On Error Resume Next 
Set Coll = New Collection 
With ComboBox2 
.Clear 
For Each cell In SourceSheet.Range("A2:A" & LastRow) 
If Len(cell.Value) <> 0 Then 
Err.Clear 
Coll.Add cell.Text, cell.Text 
If Err.Number = 0 Then .AddItem cell.Text 
End If 
Next cell 
End With 
Set Coll = Nothing 
Set SourceSheet = Nothing 
End Sub 

ich werde für jede Hilfe sehr dankbar sein.

Answer 1

Versuchen Sie folgenden Code, der ein Wörterbuch verwendet.

Public dU1 As Object, cU1 As Variant, iU1 As Long, lrU As Long 


Private Sub UserForm_Initialize() 

    Dim i As Integer 

    Set dU1 = CreateObject("Scripting.Dictionary") 
    lrU = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 
    cU1 = Worksheets("Sheet1").Range("A2:A" & lrU) 'Starts in second row. First row left for titles 
    For iU1 = 1 To UBound(cU1, 1) 
     dU1(cU1(iU1, 1)) = 1 
    Next iU1 

    'now dU1 has unique values from column A 

    For i = 0 To dU1.Count - 1 
     ComboBox1.AddItem dU1.Keys()(i) 'Load Combobox1 with unique values from Column A 
    Next 

End Sub 

Private Sub ComboBox1_Change() 
    Dim lLastRow As Long 
    Dim i As Integer 

    ComboBox2.Clear 

    For i = 0 To dU1.Count - 1 
     If CDate(ComboBox1.Value) < CDate(dU1.Keys()(i)) Then 
      ComboBox2.AddItem dU1.Keys()(i) 'Load Combobox2 
     End If 
    Next 

End Sub