刪除重複表單組合框

我正在製作具有日常銷售數據的表單。我需要彙總特定日期之間的數據。爲此，我想使用帶有2個組合框的用戶窗體（我從未與用戶窗體&控制器一起工作過）。我通過使用下面的代碼將項目添加到組合框中 -刪除重複表單組合框

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

此工作正常。但是，這是一個問題，即它在很多時間重複相同的項目，因爲在工作表中同一日期有很多交易。

爲了解決這個問題，我在互聯網搜索幫助&找到了一個程序，我修改並在我的代碼中使用。這是工作正常，但它也有一個小問題，當我點擊組合框下拉列表中的日期它會更改日期格式（即如果我選擇10/12/2016它顯示2016年十月十二日，但它應該是10日 - 12月2016）這裏是我實際修改，我不知道它的代碼，但我認爲這是將我 -

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

我將是任何幫助非常感謝的工作。

來源

2017-03-14 Nafis

如果您正在使用'Collection'來嘗試獲取唯一值，則最好使用'Dictionary'。 http://stackoverflow.com/documentation/vba/3667/scripting-dictionary-object#t=20170314080854523668 –

請嘗試下面的代碼，使用字典。

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

來源

2017-03-14 10:04:15 CMArg

@Nafis：任何反饋？代碼有幫助嗎？ – CMArg

刪除重複表單組合框

回答

相關問題