获取最新结算日期对应值的Excel VBA代码优化需求

需求说明 #

• 匹配工作簿Wb1第1列与工作簿Wb2第1列的内容
• 先过滤Wb2中M列值为Close的行
• 在符合条件的匹配行中，找到最新结算日期对应的B列值，填入Wb1的K列

原代码问题 #

原代码通过双层循环遍历数据，每次匹配到符合条件的行就直接覆盖Wb1的K列值，最终保留的是Wb2中最后一条匹配记录的B列值。这种逻辑仅在数据按结算日期从旧到新排序时有效，若实际数据未排序，无法保证取到的是最新日期对应的值，因此可靠性不足。

改进后的代码 #

Sub Get_the_respective_value_of_Last_Closing_Date()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim arr1() As Variant, arr2() As Variant
    Dim lastRow1 As Long, lastRow2 As Long
    Dim dateDict As Object
    Dim i As Long
    Dim currentKey As String
    Dim currentDate As Date
    Dim currentBValue As Variant
    
    Application.ScreenUpdating = False
    
    ' 初始化字典，存储每个A列值对应的最新日期及B列值
    Set dateDict = CreateObject("Scripting.Dictionary")
    
    Set wb1 = ThisWorkbook
    ' 替换为Wb2的实际文件路径
    Set wb2 = Workbooks.Open("Path of wb2", UpdateLinks:=False, ReadOnly:=True)
    
    Set ws1 = wb1.Sheets(1)
    Set ws2 = wb2.Sheets(1)
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    arr1 = ws1.Range("A3:K" & lastRow1).Value2
    arr2 = ws2.Range("A3:M" & lastRow2).Value2
    
    ' 遍历Wb2数据，构建最新日期字典
    For i = LBound(arr2) To UBound(arr2)
        ' 过滤M列为Close的行
        If arr2(i, 13) = "Close" Then
            currentKey = arr2(i, 1)
            ' 替换为实际结算日期所在列的索引（比如日期在C列则写3）
            If IsDate(arr2(i, 3)) Then
                currentDate = arr2(i, 3)
                currentBValue = arr2(i, 2)
                
                ' 若字典无此键，或当前日期更新，则更新记录
                If Not dateDict.Exists(currentKey) Then
                    dateDict(currentKey) = Array(currentDate, currentBValue)
                Else
                    If currentDate > dateDict(currentKey)(0) Then
                        dateDict(currentKey) = Array(currentDate, currentBValue)
                    End If
                End If
            End If
        End If
    Next i
    
    ' 遍历Wb1数据，填充K列
    For i = LBound(arr1) To UBound(arr1)
        currentKey = arr1(i, 1)
        If dateDict.Exists(currentKey) Then
            arr1(i, 11) = dateDict(currentKey)(1)
        Else
            ' 无匹配时可设为空或自定义内容
            arr1(i, 11) = ""
        End If
    Next i
    
    ' 将处理后的数据写回工作表
    ws1.Range("A3:K" & lastRow1).Value2 = arr1
    
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
    
    Set dateDict = Nothing
End Sub

代码说明 #

1. 使用Scripting.Dictionary存储每个A列值对应的最新结算日期和B列值，彻底摆脱对数据排序的依赖
2. 先遍历Wb2完成数据筛选与最新记录提取，再遍历Wb1填充结果，逻辑清晰且效率更高
3. 需根据实际数据，替换代码中结算日期列的索引（示例假设日期在C列，索引为3）

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