Question

我正在制作一张包含日常销售数据的工作表。我需要总结一个特定日期之间的数据。为此，我想使用带有2个组合框的用户表单（我之前从未使用过用户表单和控件）。我使用以下代码将项目添加到组合框中 -

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

这很好用。但是这里有一个问题，就是它重复相同的项目很多次，因为工作表中的同一日期有很多交易。

要解决此问题，请在互联网上搜索帮助＆amp;找到一个程序，我修改它并在我的代码中使用。这是正常工作，但它也有一个小问题，当我从组合框的下拉列表中点击日期时，它会更改日期格式（即如果我选择10/12/2016它显示12-oct-2016但它应该是10-DEC-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

我将非常感谢任何帮助。

Answer 1

尝试以下使用字典的代码。

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

删除重复形式的组合框

1 个答案: