检查字典项是否存在——如果存在则比较并保持较低的值

Question

我在同一个工作簿中有两个 sheet。第一个 sheet 称为 "Source"，第二个称为 "Result"。在 "Source" 上，我在 CJ 列中有一个唯一 ID。在 "Result" 上，我在 H 列中有我的 ID。"Source" 在 O 列中有日期。我正在尝试将数据从 "Source" 加载到字典中。当我加载行时，我试图检查它是否已经存在于字典中。如果是，我需要比较具有相同 ID 的日期并仅存储较低的值（最早日期）。

EX。

Row 1 ID: 123ABC    Date: Dec 10, 2017
Row 2 ID: 123ABC    Date: Dec 15, 2017
Row 3 ID: 123ABC    Date: Dec 5, 2017

宏应加载 123ABC 和 Dec 10, 2017，然后在下一行检查并发现 123ABC 存在并且将 Dec 10 保留为唯一的 123ABC 值。在下一行中，检查并替换 Dec 10 并将 Dec 5 替换为 123ABC 的唯一值。

字典完成后，我将进行查找，这将根据 ID 检索日期。此查找将使用 "Result" 上 H 列中的 ID，因为它是 "Lookup Value"，并将日期放入 "Result".

的 S 列中

我目前的代码如下：

Dim x, x2, y, y2()
Dim i As Long
Dim dict As Object
Dim LastRowForDict As Long, LastRowResult As Long, shtSource As Worksheet, shtResult As Worksheet


Set shtSource = Worksheets("Source")
Set shtResult = Worksheets("Result")
Set dict = CreateObject("Scripting.Dictionary")

'load ID and Start dates to dictionary from Source Sheet

With shtSource
    LastRowForDict = .Range("A" & rows.Count).End(xlUp).Row
    x = .Range("CJ2:CJ" & LastRowForDict).Value
    x2 = .Range("O2:O" & LastRowForDict).Value
    For i = 1 To UBound(x, 1)
        dict.Item(x(i, 1)) = x2(i, 1)
        If dict.Exists(x(i, 1)) Then

        'compare two values which shared the same key and replace existing value if new value is smaller

    Next i


End With


'map the values
With shtResult
    LastRowResult = .Range("B" & rows.Count).End(xlUp).Row
    y = .Range("H2:H" & LastRowResult).Value    'looks up to this range
    ReDim y2(1 To UBound(y, 1), 1 To 1)   '<< size the output array
    For i = 1 To UBound(y, 1)
        If dict.Exists(y(i, 1)) Then
            y2(i, 1) = dict(y(i, 1))
        Else
            y2(i, 1) = "0"
        End If
    Next i
    .Range("S2:S" & LastRowResult).Value = y2  '<< place the output on the sheet
End With

我在处理代码的比较部分时遇到问题。我认为我从行 If dict.Exists(x(i, 1)) Then 开始是正确的。我不确定是否还有其他问题？任何帮助将不胜感激。我进行了搜索，但找不到太多关于比较字典项目的内容。

提前致谢！

麦克

Answer 1

您可以尝试这样的操作...

For i = 1 To UBound(x, 1)
    If Not dict.exists(x(i, 1)) Then
        dict.Item(x(i, 1)) = x2(i, 1)
    Else
        dict.Item(x(i, 1)) = Application.Min(dict.Item(x(i, 1)), x2(i, 1))
    End If
Next i

检查字典项是否存在——如果存在则比较并保持较低的值

Check if Dict Item Exists - If Yes Then Compare And Keep Lower Value

lookup

excel

vba

dictionary