VBA UserForm初始化报错1004：WorksheetFunction.Unique调用失败

报错原因拆解 #

1. Excel版本限制：WorksheetFunction.Unique仅在Excel 365/2021及后续版本可用，若使用2019或更早版本，直接触发1004错误。
2. 多区域Range不兼容：SpecialCells(xlCellTypeVisible)返回的是不连续的多区域Range，而Unique函数无法直接处理这种类型的对象，这是最常见的触发原因。
3. 代码语法错误：
   • 变量声明不规范：Dim rang, rang1, As Range 中只有rang1是Range类型，rang默认是Variant，多余的逗号也属于语法问题；同理ListUniq(), ListNoEmpty(), As Variant的写法错误。
   • 未定义变量：代码中rang2从未声明或赋值，调用WorksheetFunction.CountA(rang2)会引发错误。
   • Range未限定工作表：Range("A" & Rows.Count)未指定所属工作表，依赖ActiveSheet可能导致逻辑错误。

修复方案 #

方案一：兼容所有Excel版本（手动去重+排序） #

如果你的Excel版本不支持Unique，用字典实现去重，手动排序：

Private Sub UserForm_Initialize()
    Dim rang As Range, rang1 As Range
    Dim lstrow As Long, x As Long, i As Long
    Dim ListUniq() As Variant
    Dim wb As Workbook, ws As Worksheet
    Dim cell As Range, temp As Variant
    Dim dict As Object
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("主表") '替换为你的工作表名称，避免用ActiveSheet
    Set rang = ws.Range("B3").CurrentRegion
    lstrow = rang.Rows.Count + 1
    
    'Step1: 筛选A列的"Dental"
    ws.Range("$A$2:$N$" & lstrow).AutoFilter _
            Field:=1, _
            Criteria1:="Dental"
    
    'Step2: 获取G列可见区域，用字典去重
    On Error Resume Next '捕获无可见单元格的情况
    Set rang1 = ws.Range("G2:G" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not rang1 Is Nothing Then
        Set dict = CreateObject("Scripting.Dictionary")
        For Each cell In rang1
            If cell.Value <> "" Then dict(cell.Value) = Empty
        Next cell
        
        '字典键转数组并手动排序
        ListUniq = dict.Keys
        For i = LBound(ListUniq) To UBound(ListUniq) - 1
            For x = i + 1 To UBound(ListUniq)
                If ListUniq(i) > ListUniq(x) Then
                    temp = ListUniq(i)
                    ListUniq(i) = ListUniq(x)
                    ListUniq(x) = temp
                End If
            Next x
        Next i
        
        'Step3: 导入列表框
        ProviderListBx.List = ListUniq
    Else
        ProviderListBx.Clear '无数据时清空列表框
    End If
    
    ws.AutoFilterMode = False '关闭筛选，可选
End Sub

方案二：适配Excel 365/2021版本（修复多区域问题） #

如果你的Excel支持Unique，先把多区域Range转成一维数组再处理：

Private Sub UserForm_Initialize()
    Dim rang As Range, rang1 As Range
    Dim lstrow As Long, x As Long, idx As Long
    Dim ListUniq() As Variant, tempArr() As Variant
    Dim wb As Workbook, ws As Worksheet
    Dim cell As Range
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("主表") '替换为你的工作表名称
    Set rang = ws.Range("B3").CurrentRegion
    lstrow = rang.Rows.Count + 1
    
    'Step1: 筛选A列的"Dental"
    ws.Range("$A$2:$N$" & lstrow).AutoFilter _
            Field:=1, _
            Criteria1:="Dental"
    
    'Step2: 获取G列可见区域，转为一维数组
    On Error Resume Next
    Set rang1 = ws.Range("G2:G" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not rang1 Is Nothing Then
        '将多区域单元格转成一维数组
        ReDim tempArr(1 To rang1.Cells.Count)
        idx = 1
        For Each cell In rang1
            tempArr(idx) = cell.Value
            idx = idx + 1
        Next cell
        
        '去重+排序
        ListUniq = WorksheetFunction.Unique(tempArr)
        ListUniq = WorksheetFunction.Sort(ListUniq)
        
        '去除空值
        idx = 0
        For x = LBound(ListUniq) To UBound(ListUniq)
            If ListUniq(x) <> "" Then
                idx = idx + 1
                ListUniq(idx) = ListUniq(x)
            End If
        Next x
        If idx > 0 Then
            ReDim Preserve ListUniq(1 To idx)
        Else
            ReDim ListUniq(0)
        End If
        
        'Step3: 导入列表框
        ProviderListBx.List = ListUniq
    Else
        ProviderListBx.Clear
    End If
    
    ws.AutoFilterMode = False
End Sub

关键注意点 #

• 避免使用ActiveSheet，直接指定工作表名称，防止切换工作表时出现逻辑错误。
• 处理SpecialCells必须加错误捕获，否则筛选后无可见单元格会直接报错。
• 变量声明要逐个指定类型，避免默认Variant类型带来的潜在问题。

内容的提问来源于stack exchange，提问作者Ngabo