VBA实现从固定单元格统计列内不同值数量的问题

需求：从A列A5单元格开始，统计到该列最后一个非空单元格内的不同供应商数量。此前手动指定A5:A50范围的代码能得到正确结果，但尝试动态设置范围时多次报错或结果错误。原代码逻辑为统计A5:A50的唯一值，再减去加粗标题数量并额外减1，原代码如下：

Sub Count_Values_()

Sheets("Präsentation").Select

Dim dblAnz As Double
Dim rngRange As Range, rngRangeCnt As Range

Set rngRange = Range("A5:A50")

For Each rngRangeCnt In rngRange
    dblAnz = dblAnz + 1 / WorksheetFunction.CountIf(rngRange, rngRangeCnt.Text)
Next

Dim Bereich  As Range
Dim Zelle    As Range
Dim lAnzahl  As Long

Set Bereich = Range("A5:A50")
   
For Each Zelle In Bereich
    If Zelle.Font.Bold = True Then
        lAnzahl = lAnzahl + 1
    End If
Next Zelle

Sheets("Anleitung").Select

Range("F1").Value = dblAnz - lAnzahl - 1

End Sub

改进方案 #

1. 动态获取数据范围

用Cells(Rows.Count, "A").End(xlUp).Row获取A列最后一个非空单元格的行号，以此构建动态范围，避免手动指定固定行号的局限。

2. 用字典优化唯一值统计

使用VBA字典（Dictionary）存储唯一供应商名称，自动去重，比原代码的CountIf循环更高效，还能自动跳过空单元格。

3. 合并遍历逻辑

在遍历统计唯一值的同时，同步统计加粗单元格数量，减少一次遍历操作。

改进后的代码：

Sub CountUniqueSuppliers()
    Dim wsPres As Worksheet
    Dim wsGuide As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim cell As Range
    Dim uniqueSuppliers As Object
    Dim boldCount As Long
    
    ' 指定工作表，避免用Select切换
    Set wsPres = ThisWorkbook.Sheets("Präsentation")
    Set wsGuide = ThisWorkbook.Sheets("Anleitung")
    Set uniqueSuppliers = CreateObject("Scripting.Dictionary")
    
    ' 获取A列最后非空行号
    lastRow = wsPres.Cells(wsPres.Rows.Count, "A").End(xlUp).Row
    
    ' 构建从A5到最后非空行的范围
    If lastRow >= 5 Then
        Set dataRange = wsPres.Range("A5:A" & lastRow)
    Else
        ' 若A5及以上无数据，直接返回0
        wsGuide.Range("F1").Value = 0
        Exit Sub
    End If
    
    boldCount = 0
    
    ' 遍历范围，统计唯一供应商和加粗单元格
    For Each cell In dataRange
        ' 跳过空单元格
        If cell.Value <> "" Then
            ' 统计唯一值
            If Not uniqueSuppliers.Exists(cell.Text) Then
                uniqueSuppliers.Add cell.Text, 1
            End If
            ' 统计加粗单元格
            If cell.Font.Bold Then
                boldCount = boldCount + 1
            End If
        End If
    Next cell
    
    ' 计算最终结果：唯一值数量 - 加粗标题数量 -1（对应原逻辑的额外减1）
    wsGuide.Range("F1").Value = uniqueSuppliers.Count - boldCount - 1
    
    ' 释放对象
    Set uniqueSuppliers = Nothing
    Set wsPres = Nothing
    Set wsGuide = Nothing
End Sub

代码说明 #

• 避免使用Select切换工作表，直接通过工作表对象操作，更稳定高效
• 加入边界判断：如果A5以下没有数据，直接返回0，防止报错
• 用字典存储唯一值，自动去重，数据量大时效率远高于原方法
• 一次遍历完成两个统计任务，减少代码冗余

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