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



我是新手。(请原谅我的英语(

我已经为自己创建了一个发票,有一个视图用户表单,它使用以下代码初始化:

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"。

你能指导我吗?

提前谢谢。

使用字典跟踪唯一值:

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

最新更新