VBA使用Dictionary按指定键提取记录并写入工作表的问题咨询

实现思路 #

• 新增读取待查询ID区域（H2:H6）的逻辑
• 逐行校验待查询ID是否存在于字典中，避免调用不存在的键抛出错误
• 匹配到的记录直接写入对应行的右侧单元格，可自行调整写入位置

完整修改后代码 #

Sub CheckID()
    ' 声明并创建Dictionary对象
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary

    ' 获取工作表对象
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    
    ' 使用CurrentRegion获取所有相邻数据的区域
    Dim rg As Range
    Set rg = sh.Range("A1").CurrentRegion
    
    Dim objectID As clsDetector, i As Long, ID As Long
    ' 遍历读取数据写入字典
    For i = 2 To rg.Rows.Count
        ID = rg.Cells(i, 1).Value
        ' 创建新的clsDetector对象
        Set objectID = New clsDetector
        ' 赋值属性
        objectID.Name = rg.Cells(i, 2).Value
        objectID.DetectorType = rg.Cells(i, 3).Value
        objectID.DetectorValue = rg.Cells(i, 4).Value
        ' 将新的clsDetector对象添加到字典中
        dict.Add ID, objectID
    Next i
    
    ' 读取H列待查询ID，匹配后写入工作表
    Dim queryRg As Range, queryCell As Range
    Set queryRg = sh.Range("H2:H6") ' 待查询的ID区域
    ' 写入表头，不需要可直接删除
    sh.Range("I1") = "名称"
    sh.Range("J1") = "检测器类型"
    sh.Range("K1") = "检测器值"
    
    For Each queryCell In queryRg
        ' 跳过空单元格
        If VBA.Len(queryCell.Value) > 0 And VBA.IsNumeric(queryCell.Value) Then
            ID = queryCell.Value
            ' 判断字典中是否存在该ID
            If dict.Exists(ID) Then
                Set objectID = dict(ID)
                ' 写入对应行的I、J、K列，调整Offset参数即可修改写入位置
                queryCell.Offset(0, 1) = objectID.Name
                queryCell.Offset(0, 2) = objectID.DetectorType
                queryCell.Offset(0, 3) = objectID.DetectorValue
            Else
                ' 不存在的ID标记为无匹配
                queryCell.Offset(0, 1) = "无匹配记录"
            End If
        End If
    Next queryCell
    
    ' 原有输出到立即窗口的逻辑保留
    Dim IDnumber As Variant
    For Each IDnumber In dict.Keys
        Set objectID = dict(IDnumber)
        With objectID
            Debug.Print IDnumber, .Name, .DetectorType, .DetectorValue
        End With
    Next IDnumber
End Sub

注意事项 #

• 运行前请确保已经勾选「工具-引用」中的Microsoft Scripting Runtime，否则字典对象会报错
• 原有clsDetector类模块代码无需修改，可直接使用
• 如果待查询区域范围有变动，修改queryRg对应的单元格范围即可

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