如何在20005行的长数据区域统计唯一值？能否用VBA实现？

当然可以用VBA解决，而且针对2万行左右的数据，VBA的效率会比你之前用的数组公式高很多——数组公式会对每个单元格重复执行COUNTIF计算，大量重复运算直接导致卡顿，而VBA可以通过字典（Dictionary）或临时区域去重的方式，只遍历一次数据就能完成统计。

方法1：使用字典（推荐，高效且不修改原数据） #

字典是VBA中处理唯一值的利器，它的存在性判断是即时的，适合大数量级数据：

Sub CountUniqueValues()
    Dim targetRng As Range
    Dim cell As Range
    Dim uniqueDict As Object
    Dim lastRow As Long
    Dim uniqueCount As Long
    
    ' 定义目标数据区域（这里指定A5:A20005，也可以自动获取最后一行）
    lastRow = 20005
    Set targetRng = ThisWorkbook.Sheets("Sheet1").Range("A5:A" & lastRow)
    
    ' 创建字典对象（后期绑定，无需额外引用库）
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历区域，收集非空唯一值
    For Each cell In targetRng
        ' 跳过错误值和空单元格，仅添加唯一值
        If Not IsError(cell.Value) And cell.Value <> "" Then
            If Not uniqueDict.Exists(cell.Value) Then
                uniqueDict.Add cell.Value, cell.Value
            End If
        End If
    Next cell
    
    ' 获取唯一值数量
    uniqueCount = uniqueDict.Count
    
    ' 输出结果（可选择弹窗或写入单元格）
    MsgBox "非空唯一值数量：" & uniqueCount
    ' 示例：将结果写入B1单元格
    ' ThisWorkbook.Sheets("Sheet1").Range("B1").Value = uniqueCount
    
    ' 释放内存
    Set uniqueDict = Nothing
    Set targetRng = Nothing
End Sub

方法2：临时区域去重（无需字典，操作直观） #

如果不想用字典，也可以通过临时工作表复制数据后去重统计：

Sub CountUniqueWithTempSheet()
    Dim targetRng As Range
    Dim tempSheet As Worksheet
    Dim tempRng As Range
    Dim uniqueCount As Long
    Dim lastRow As Long
    
    lastRow = 20005
    Set targetRng = ThisWorkbook.Sheets("Sheet1").Range("A5:A" & lastRow)
    
    ' 创建临时工作表
    Set tempSheet = ThisWorkbook.Sheets.Add
    Set tempRng = tempSheet.Range("A1:A" & targetRng.Rows.Count)
    
    ' 复制原数据到临时区域
    targetRng.Copy tempRng
    
    ' 执行去重
    tempRng.RemoveDuplicates Columns:=1, Header:=xlNo
    
    ' 统计非空唯一值数量（排除错误值）
    On Error Resume Next ' 处理全空的极端情况
    uniqueCount = tempRng.SpecialCells(xlCellTypeConstants).Count
    On Error GoTo 0
    
    ' 输出结果
    MsgBox "非空唯一值数量：" & uniqueCount
    
    ' 删除临时工作表（关闭删除提示）
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
End Sub

注意事项 #

• 把代码中的Sheet1替换成你实际的工作表名称；
• 如果数据中包含错误值（比如#N/A、#VALUE!），方法1的代码已经做了跳过处理，方法2可以根据需要添加错误值过滤；
• 两种方法都不会修改原数据，运行后直接得到统计结果，2万行数据几乎瞬间完成。

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