Dim c As Range, Coll As New Collection
On Error Resume Next
For Each c In Sheet6.[a2:a100000]
Coll.Add c.Value, c.Value
Next c
On Error GoTo 0
For Each Item In Coll
ComboBox1.AddItem Item
Next Item
Private Sub ComboBox1_Change()
Dim cell As Range
Dim LIST2 As New Collection
Z2 = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row
ComboBox2.Clear
On Error Resume Next
For Each cell In Range("B2:B" & Z2)
If cell.Offset(0, -1) = ComboBox1 Then
LIST2.Add cell, CStr(cell)
End If
Next
For I = 1 To LIST2.Count
ComboBox2.AddItem LIST2.Item(I)
Next
End Sub
کامنت