时间戳

首页 > 解决方案 > 将字典键与工作表单元格值匹配

excel - 将字典键与工作表单元格值匹配

问题描述

我还没有找到与该主题相关的任何问题，因此我的问题如下。

我正在使用字典，其中包含如下所示的键和项目。

Keys:  30 31 32 33 34 35 36 37 39
Items: 21 51 31 64 65 32 29 74 61

我也有一些值写入工作表：

27 28 29 30 31 32 33 34 35 36 37 38 39 40

我的目标是调整字典的大小，并将其中包含的项目写入与字典键匹配的单元格下方的单元格中。

到目前为止，我只能将字典写入工作表 ws 中的给定位置：

ws.Range("C28").Resize(1, dict.Count).Value2 = dict.Keys
ws.Range("C29").Resize(1, dict.Count).Value2 = dict.Items

我已经尝试了以下代码，但这只是一个开始。当然，这不是我要去的地方，但这是我能想到的。任何帮助或积分将不胜感激。谢谢。

Dim key As Variant
Dim cell As Range

With ws
For Each cell In .Range("D10:S10")
    If dict.Exists(cell.Value) Then
        cell.Offset(2, 0).Value = dict.Items
    End If
Next

For Each key In dict
    With .Cells(.Rows.Count, 4).End(xlUp).Offset(1)
        .Value = key
        .Offset(, 2) = dict(key)
    End With
Next

结束于

工作表结果示例： 在此处输入图像描述

评论后代码更新（具体问题尚未完成，但概念验证。正在开发中，并带有评论。）

Sub TEST()
    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet2")   ' <- change the sheet name
    Dim oDict As New Scripting.Dictionary
    Dim iRow As Long: iRow = oWS.Cells(oWS.Rows.Count, 10).End(xlUp).Row                                      ' <- iRow and be set dynamically
    Dim oCell As Range
    
    oDict.Add 30, 70
    oDict.Add 31, 71
    oDict.Add 32, 72
    oDict.Add 33, 73
    oDict.Add 34, 74
    oDict.Add 35, 75
    oDict.Add 36, 76
    oDict.Add 37, 77
    oDict.Add 38, 78
    oDict.Add 39, 79
    oDict.Add 40, 80
    oDict.Add 42, 82
    
    With oWS
        
        For Each oCell In .Range("A1:P1")
        
            If oDict.Exists(oCell.Value) Then
                iRow = iRow + 1
                '.Cells(1, iRow).Value = oCell.Value
                .Cells(2, iRow).Value = oDict.Item(oCell.Value)
            End If
        
        Next
        
    End With

End Sub

标签： excelvbadictionaryfor-loop

解决方案

这可能过度简化了问题，但如果我正确理解您的要求，这应该可以

Sub SetDictValues()

    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet3")
    Dim oDict As New Scripting.Dictionary
    Dim iRow As Long: iRow = oWS.Cells(oWS.Rows.Count, 1).End(xlUp).Row
    Dim rKeys As Range: Set rKeys = oWS.Range("A2:A" & iRow)
    Dim rUpdateRng As Range
    Dim oCell As Range
    
    oDict.Add 30, 70
    oDict.Add 31, 71
    oDict.Add 32, 72
    oDict.Add 33, 73
    oDict.Add 34, 74
    oDict.Add 35, 75
    oDict.Add 36, 76
    oDict.Add 37, 77
    oDict.Add 38, 78
    oDict.Add 39, 79
    oDict.Add 40, 80
    
    With oWS
        
        For Each oCell In .Range("A1:K1")
        
            If oDict.Exists(oCell.Value) Then
                
                Set rUpdateRng = rKeys.Find(oCell.Value)
                If Not rUpdateRng Is Nothing Then
                    rUpdateRng.Offset(, 2).Value = oDict.Item(oCell.Value)
                End If
            End If
        
        Next
        
    End With
    
End Sub

推荐阅读