如何统计Scripting Dictionary中的匹配条目？VBA代码优化求助

以下是满足需求的修改后代码，同时优化了部分逻辑的健壮性：

Option Explicit
Sub Unique_Ref()
    Dim ar(), rg As Range
    Dim r As Long, CoTy As String, CoTr As String
    Dim Wb As Workbook, ShD As Worksheet
    Dim dict As Object
    Dim matchCount As Long ' 统计找到的唯一条目数
    Dim mKey As Variant
    Dim targetCol As ListColumn
    Dim nextRow As Range
    
    Set Wb = ThisWorkbook
    Set ShD = Wb.Sheets("Data")
    Set dict = CreateObject("Scripting.Dictionary")
    Set targetCol = ShD.ListObjects("MTypes").ListColumns("Missing references")
    
    matchCount = 0 ' 初始化计数器
    
    ' 简化数据范围获取：取F2到G列最后一行的有效数据
    With ShD
        Set rg = .Range("F2:G" & .Cells(.Rows.Count, "F").End(xlUp).Row)
    End With
    ar = rg.Value
    
    ' 遍历数据，填充字典并统计有效条目
    For r = 1 To UBound(ar)
        CoTr = Trim(ar(r, 1)) ' 交易引用
        CoTy = Trim(ar(r, 2)) ' 交易类型
        
        ' 只处理交易类型为空的记录
        If Len(CoTy) = 0 Then
            If Not dict.Exists(CoTr) Then
                dict.Add CoTr, r
                matchCount = matchCount + 1 ' 每新增一个唯一引用，计数器加1
            End If
        End If
    Next r
    
    ' 没有找到匹配条目，直接退出，跳过写入流程
    If matchCount = 0 Then Exit Sub
    
    ' 将唯一引用写入MTypes表的Missing references列
    For Each mKey In dict.Keys
        ' 处理列表为空的情况，避免报错
        If targetCol.DataBodyRange Is Nothing Then
            Set nextRow = targetCol.Range.Cells(1)
        Else
            Set nextRow = targetCol.DataBodyRange.End(xlDown).Offset(1, 0)
        End If
        nextRow.Value = mKey
    Next mKey
    
    ' 完成写入后退出子程序
    Exit Sub
End Sub

核心改动说明 #

• 添加计数器统计：新增matchCount变量，每次向字典添加新的唯一交易引用时递增，准确统计符合条件的条目数量
• 跳过无效循环：通过If matchCount = 0 Then Exit Sub判断，没有找到匹配条目时直接退出，不执行后续的字典遍历写入操作
• 优化范围获取：简化原代码中冗余的范围定义逻辑，直接定位有效数据区域，提升代码效率
• 健壮性优化：处理MTypes表为空的情况，避免写入时出现运行时错误
• 按需退出子程序：完成写入操作后立即执行Exit Sub，确保任务完成后退出

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