打造具有唯一值的下拉列表

joeyyang5

Rem VBA知识点：ComboBox
Dim arr()    '声明公共变量，过程结果时可保留其值
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 Then   '选择第一列时出现复合框
        On Error Resume Next
        Debug.Print UBound(arr)  '该句的作用是测试数组arr是否有值，如果数组为空产生错误
        If Err <> 0 Then  '如果有错误（表示空数为空），那么对数据源过滤重复值，并添加到数组
            Dim cell As Range, onlys As New Collection, Item As Long
            On Error Resume Next
            With Sheets("Data")
                For Each cell In .Range(.[a1], .Cells(Rows.Count, 1).End(xlUp))
                    onlys.Add cell.Value, CStr(cell.Text)  '过滤重复值
                Next
                On Error GoTo 0
                '重置数组大小，其上界等于不重复数的个数
                ReDim arr(1 To onlys.Count, 1 To 2)
                For Item = 1 To onlys.Count
                    '将不重复值逐个加入数组arr，其第一列来自onlys对象，第二列利用Vlookup从Data工作表中引用
                    arr(Item, 1) = onlys(Item)
                    arr(Item, 2) = WorksheetFunction.VLookup(onlys(Item), .Range(.[a1], .Cells(Rows.Count, 2).End(xlUp)), 2, 0)
                Next
            End With
            With Me.ComboBox1
                .List = arr    '将数组赋与列表框
                .ColumnCount = 2  '默认显示二列
                .BoundColumn = 1    '将第一列导入单元格，也可以修改为第二列
                .ColumnWidths = "30,30"  '每列宽度
                .Width = 80  '整体宽度
                .BackColor = &H80000003  '背景色
                .ListStyle = fmListStyleOption    '设置样式
            End With
        End If
        With Me.ComboBox1    '如果无错误（表示数据存在），那么直接改复合框的链接地址与位置即可，不需要再计算过滤重复值，产生数组
            .LinkedCell = Target(1).Address
            .Top = Target.Top            '高度与活动单元格一致
            .Left = Target.Offset(0, 1).Left  '显示在活动单元格右方
            .Visible = True                '保持可见
        End With
    Else
        Me.ComboBox1.Visible = False  '在其它列单击时隐藏复合框
    End If
End Sub

xww_cpa

收藏了，试试     

309565063

顶                                             

qhqn

顶，很好！，练习！练习

fulanks

感谢楼主分享