我使用下面的代碼來填充ComboBox在userform中vba具有唯一值。我使用相同的代碼填充另外兩個ComboBoxes，它作業正常。當列中的資料是數字時它不起作用。在同一列中，如果我將數字更改為文本，則它可以作業。我怎樣才能讓它也與數字一起作業？
Sub uniqueYear()
Dim myCollection As Collection
On Error Resume Next
Set myCollection = New Collection
With Me.cbxYear
.Clear
For Each cell In Sheets("Sheet1").range("AC2:AC" & Cells(Rows.Count, 1).End(xlUp).Row)
If Len(cell) <> 0 Then
Err.Clear
myCollection.Add cell.Value, cell.Value
If Err.Number = 0 Then .AddItem cell.Value
End If
Next cell
End With
End Sub
uj5u.com熱心網友回復：
我會將收集唯一值的作業提取到一個單獨的方法中：
Sub uniqueYear()
Dim myCollection As Collection, v, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'activeworkbook?
Set myCollection = UniqueCollection(ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row))
With Me.cbxYear
.Clear
For Each v In myCollection
.AddItem v
Next v
End With
End Sub
Function UniqueCollection(rng As Range) As Collection
Dim c As Range, col As New Collection, v
On Error Resume Next
For Each c In rng.Cells
v = c.Value
If Not IsError(v) Then
If Len(v) > 0 Then col.Add v, CStr(v) 'Key needs to be a String
End If
Next c
On Error GoTo 0
Set UniqueCollection = col
End Function
uj5u.com熱心網友回復：
使用字典的替代方法
Sub uniqueYear()
Dim dict As Object, ar, r As Long, k As String
Set dict = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
r = .Cells(.Rows.Count, "AC").End(xlUp).Row
ar = .Range("AC2:AC" & r).Value2
For r = 1 To UBound(ar)
k = Trim(ar(r, 1))
If Len(k) > 0 Then dict(k) = r
Next
End With
Me.cbxYear.List = dict.keys
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qianduan/382708.html