求助：合并Excel宏实现列值统计与指定范围非空检查

我正在学习Excel VBA宏，目前已实现两个功能：1. 通过指定链接的方法统计某列中不同值的出现次数；2. 编写宏检查指定单元格范围是否包含内容。现需求是将这两个宏合并，实现：当A列中某个值（如“Sample”）出现N次时，检查B列对应前N行的范围是否有值，但无法完成合并，请求协助。现有两段宏代码如下：

'Set reference to Microsoft Scripting Runtime
'  or use late binding
Option Explicit
Sub UniqueCounts()
    Dim myD As Dictionary
    Dim vArr As Variant
    Dim WS As Worksheet
    Dim I As Long, sKey As String, v As Variant, s As String

Set WS = ThisWorkbook.Worksheets("sheet1")
With WS
    vArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set myD = New Dictionary
    myD.CompareMode = TextCompare

For I = 1 To UBound(vArr)
    sKey = vArr(I, 1)
    If Not myD.Exists(sKey) Then
        myD.Add Key:=sKey, Item:=1
    Else
        myD(sKey) = myD(sKey) + 1
    End If
Next I

For Each v In myD
    s = s & vbLf & v & " (" & myD(v) & ")"
Next v

s = Mid(s, 2)
MsgBox (s)

End Sub

Sub TestIsEmpty()
    If WorksheetFunction.CountA(Range("B1:B3")) > 0 Then
        MsgBox "Not Empty"
    Else
        MsgBox "Empty"
    End If
End Sub

解决方案 #

核心逻辑是先统计目标值在A列的出现次数，再动态生成B列对应范围并检查内容。以下是合并后的完整代码：

'Set reference to Microsoft Scripting Runtime
'  or use late binding
Option Explicit
Sub CheckTargetValueAndRange()
    Dim myD As Dictionary
    Dim vArr As Variant
    Dim WS As Worksheet
    Dim targetValue As String
    Dim countN As Long
    Dim checkRange As Range
    Dim I As Long ' 补充变量声明，避免编译错误
    
    ' 设置要检查的目标值，可按需修改
    targetValue = "Sample"
    Set WS = ThisWorkbook.Worksheets("sheet1")
    
    ' 读取A列所有数据到数组，提升处理效率
    With WS
        vArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    
    ' 统计A列各值的出现次数
    Set myD = New Dictionary
    myD.CompareMode = TextCompare
    
    For I = 1 To UBound(vArr)
        Dim sKey As String
        sKey = vArr(I, 1)
        If Not myD.Exists(sKey) Then
            myD.Add Key:=sKey, Item:=1
        Else
            myD(sKey) = myD(sKey) + 1
        End If
    Next I
    
    ' 处理目标值的检查逻辑
    If myD.Exists(targetValue) Then
        countN = myD(targetValue)
        ' 动态生成B列前N行的检查范围
        Set checkRange = WS.Range("B1:B" & countN)
        
        ' 检查范围是否包含内容
        If WorksheetFunction.CountA(checkRange) > 0 Then
            MsgBox targetValue & "出现" & countN & "次，B列前" & countN & "行不为空"
        Else
            MsgBox targetValue & "出现" & countN & "次，B列前" & countN & "行为空"
        End If
    Else
        MsgBox "A列中未找到目标值：" & targetValue
    End If
End Sub

关键细节说明 #

• 自定义目标值：修改targetValue = "Sample"即可切换要统计的A列值
• 效率优化：将A列数据一次性读取到数组vArr中处理，比逐单元格循环更快
• 动态范围：通过"B1:B" & countN自动生成对应范围，无需手动调整行号
• 错误防护：增加了目标值不存在时的提示，避免程序报错

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