带有图表值的两列列表框

Question

我是新手。 （请原谅我的英语）

我已经创建了自己的发票，有一种观点用户的形式，与此代码初始化：

Private Sub UserForm_Initialize() 

    'Populate listbox with unique invoice numbers from sheet "Invoice data" 

    Dim Test As New Collection 
    Dim rng As Variant 
    Dim Value As Variant 

    'Identify range 
    rng = Sheets("Invoice data").Range("A2:A" & _ 
    Sheets("Invoice data").Columns("A").Find("*", _ 
    SearchOrder:=xlRows, SearchDirection:=xlPrevious, _ 
    LookIn:=xlValues).Row) 

    'Filter unique values 
    On Error Resume Next 
    For Each Value In rng 
    If Len(Value) > 0 Then Test.Add Value, CStr(Value) 
    Next Value 
    On Error GoTo 0 

    For Each Value In Test 
    ListBox1.AddItem Value 
    Next Value 

    ListBox1.ListIndex = 0 

End Sub 

在此用户表单我有一个列表框，显示表单中的ID号（“发票数据”）范围是列“A”。

我需要这个列表框转换成两组中，第一列应显示“A”和下一列应显示“C”。

你可以指导我？

在此先感谢。

Answer 1

使用字典来追踪唯一值：

Private Sub UserForm_Initialize() 

    'Populate listbox with unique invoice numbers from sheet "Invoice data" 
    Dim dict As Object, sht As Worksheet 
    Dim rng As Range, c As Range, v, i As Long 

    Set dict = CreateObject("scripting.dictionary") 
    Set sht = Sheets("Invoice data") 

    'Identify range 
    Set rng = sht.Range("A2:A" & _ 
     sht.Columns("A").Find("*", SearchOrder:=xlRows, _ 
     SearchDirection:=xlPrevious, LookIn:=xlValues).Row) 

    'Filter unique values 
    For Each c In rng.Cells 
     v = c.Value 
     'any value to add? 
     If Len(v) > 0 Then 
      'new value? 
      If Not dict.exists(v) Then 
       With Me.ListBox1 
        .AddItem 
        .List(i, 0) = v 
        .List(i, 1) = c.Offset(0, 2).Value 
       End With 
       i = i + 1 
       dict.Add v, 1 
      End If 
     End If 
    Next c 

    Me.ListBox1.ListIndex = 0 

End Sub