在Excel-VBA中向列表框添加唯一项

vojdkbi0  于 2022-12-19  发布在  其他
关注(0)|答案(4)|浏览(135)

我目前正在为一个文件编写VBA代码,该文件包含表中列出的大量数据,其中一些数据是重复的。
我想在用户表单中填充一个列表框,这样我就只得到唯一的数据值。
下面是我编写的代码:

'Year listbox population
With ThisWorkbook.Worksheets("Data")

LastNonEmptyRow = .Range("C1").End(xlDown).Row

For i = 2 To LastNonEmptyRow
    For j = 0 To BudgetEdit.SelectedYear.ListCount
        If .Cells(i, 3) <> BudgetEdit.SelectedYear.List(j) Then BudgetEdit.SelectedYear.AddItem .Cells(i, 3)
    Next
Next

End With

当我运行上面的代码时,我没有得到任何错误提示,但是列表框没有被填充,尽管数据表中有数据。
会喜欢一些智慧在这上面。
谢谢,如果这个问题已经在另一篇文章中被问到了,我很抱歉。

pkmbmrz7

pkmbmrz71#

您的代码中有一些逻辑错误。

  1. list循环中的If语句是不够的,因为它会为每个不同的项添加一个项,这没有任何意义。为了处理它,我添加了一个布尔变量来声明至少有一个项是相同的doAdd = False,因此不应该添加该项。
    1.如果列表一开始为空,则BudgetEdit.SelectedYear.ListCount = 0。第二个循环运行一次,BudgetEdit.SelectedYear.List(j)为null。null语句不能计算为布尔语句,只能使用IsNull()函数,因此必须避免在布尔If语句中使用null。
    1.您的第二个循环被设置为运行For j = 0 To BudgetEdit.SelectedYear.ListCount,这是一个不正确的计数。您需要将其设置为BudgetEdit.SelectedYear.ListCount - 1。这样也可以避免空的情况。
    你需要这样做:
Dim doAdd As Boolean
For i = 2 To LastNonEmptyRow
    doAdd = True
    For j = 0 To BudgetEdit.SelectedYear.ListCount - 1
        If .Cells(i, 3) = BudgetEdit.SelectedYear.List(j) Then
            doAdd = False
            Exit For
        End If
    Next
    If doAdd Then BudgetEdit.SelectedYear.AddItem .Cells(i, 3)
Next
vhmi4jdf

vhmi4jdf2#

@depatinkin
我发现了另一个使用集合的解决方案,效果很好:

Dim i, LastNonEmptyRow as integer
Dim Cell As Range
Dim Unique As New Collection
Dim Item As Range

LastNonEmptyRow = ThisWorkbook.Worksheets("Data").Range("B1").End(xlDown).Row

On Error Resume Next
For Each Cell In ThisWorkbook.Worksheets("Data").Range("B2:B" & LastNonEmptyRow)
    Unique.Add Cell, Cstr(Cell)
NextCell
On Error GoTo 0

For Each Item In Unique
   .SelectedDate.AddItem Item
Next Item

谢谢你的帮助。

sxissh06

sxissh063#

以下方法使用字典和变量数组(而不是范围)来计算速度:

Sub Recut()
Dim ws As Worksheet
Dim x
Dim objDic As Object
Dim lngCnt As Long

Set objDic = CreateObject("scripting.dictionary")
Set ws = ThisWorkbook.Worksheets("Data")
x = ws.Range(ws.[c1], ws.Cells(Rows.Count, "C").End(xlUp)).Value2

For lngCnt = 1 To UBound(x)
    If Not objDic.exists(x(lngCnt, 1)) Then
        If Len(objDic.exists(x(lngCnt, 1))) > 0 Then
        objDic.Add x(lngCnt, 1), 1
        'add to your userform here
        End If
    End If
Next

End Sub
llew8vvj

llew8vvj4#

似乎我找到了整洁的解决方案(忘了来源):

Sub addIfUnique(CB As ComboBox, Mystr As String)
'v 2.0 2020-03-03 ignore blanks
If Mystr = vbNullString Then Exit Sub
    If CB.ListCount = 0 Then GoTo doAdd
    Dim i As Integer
    'MsgBox (MyStr)
    For i = 0 To CB.ListCount - 1
        If LCase(CB.List(i)) = LCase(Mystr) Then Exit Sub
    Next
doAdd:
    CB.AddItem Mystr
End Sub

你可以这样调用它:

Me.ComboBox4.Clear
    Dim Mystr As String
    i = 2
    Do Until SProducts.Cells(i, 4).Value = ""
      Mystr = CStr(SProducts.Cells(i, 4).Value)
      If SProducts.Cells(i, 6).Value = Me.ComboBox0.Value Then
          addIfUnique Me.ComboBox4, Mystr
      End If
      If Me.ComboBox0.Value = vbNullString Then addIfUnique Me.ComboBox4, Mystr 'all machines 2019-01-07
      
      i = i + 1
   Loop

相关问题