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号（＆＃34;发票数据＆＃34;）范围是列＆＃34; A＆＃34;。

我需要将此列表框转换为两列框，第一列应显示＆＃34; A＆＃34;下一栏应该显示＆＃34; C＆＃34;。

你能指导我吗？

提前致谢。

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

带有工作表值的两列列表框

1 个答案: