请尝试下一个修改过的代码。它使用一个字典来保存打开的工作簿的唯一kay（和“K：K”中的最后一个值作为项目），然后将适当的数据放入工作簿：

Sub Get_Last_Closing_Date()

   Dim wb1 As Workbook, wb2 As Workbook
   Dim ws1 As Worksheet, ws2 As Worksheet
   Dim rng1 As Range, rng2 As Range
   Dim arr1() As Variant, arr2() As Variant
   Dim dict As Object
   
   Application.ScreenUpdating = False

   Set wb1 = ThisWorkbook
   'Please, update the real path of "Book2.xlsx":
   Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)
   
    Set ws1 = wb1.Sheets(1)
    Set ws2 = wb2.Sheets(1)
   
     Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)   'Main Range
     Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

      arr1 = rng1.Value2
      arr2 = rng2.Value2

     'place the unique last key in a dictionary:
     Dim i As Long
     Set dict = CreateObject("Scripting.dictionary")
     For i = 1 To UBound(arr2)
        If arr2(i, 13) = "Close" Then
             dict(arr2(i, 1)) = arr2(i, 2)
        End If
    Next i
    Debug.Print Join(dict.items, "|") 'just to visualy see the result
    
    'Place the necessary data in its place:
    For i = 1 To UBound(arr1)
        If dict.Exists(arr1(i, 1)) Then
            arr1(i, 11) = dict(arr1(i, 1))
        Else
            arr1(i, 11) = "NA"
        End If
    Next i
    
    rng1.Value2 = arr1 'drop back the updated array content
    
   wb2.Close SaveChanges:=False
   
   Application.ScreenUpdating = True
   MsgBox "Ready..."
End Sub

要打开的工作簿的“K：K”列必须按升序排序...

编辑日期：

下一个版本不需要对列“K：K”进行排序：

Sub Get_Last_Closing_Date()
   Dim wb1 As Workbook, wb2 As Workbook
   Dim ws1 As Worksheet, ws2 As Worksheet
   Dim rng1 As Range, rng2 As Range
   Dim arr1() As Variant, arr2() As Variant
   Dim dict As Object
   
   Application.ScreenUpdating = False

   Set wb1 = ThisWorkbook
   Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)
   
    Set ws1 = wb1.Sheets(1)
    Set ws2 = wb2.Sheets(1)
   
     Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)   'Main Range
     Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

      arr1 = rng1.Value2
      arr2 = rng2.Value2

     'place the unique last key in a dictionary:
     Dim i As Long
     Set dict = CreateObject("Scripting.dictionary")
     For i = 1 To UBound(arr2)
        If arr2(i, 13) = "Close" Then
            If Not dict.Exists(arr2(i, 1)) Then
                dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11)) 'place the date from K:K, too
            Else
                If CDate(arr2(i, 11)) > CDate(dict(arr2(i, 1))(1)) Then 'change the item only in case of a more recent date:
                    dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11))
                End If
            End If
        End If
    Next i

    'Place the necessary data in its place:
    For i = 1 To UBound(arr1)
        If dict.Exists(arr1(i, 1)) Then
            arr1(i, 11) = dict(arr1(i, 1))(0) 'extract first item array element
        Else
            arr1(i, 11) = "NA"
        End If
    Next i
    
    rng1.Value2 = arr1 'drop back the updated array content
    
   wb2.Close SaveChanges:=False
   
   Application.ScreenUpdating = True
   MsgBox "Ready..."
End Sub

您可能会受益于Excel中的函数，并将它们与通过VBA进行评估结合起来。正如我所做的示例：

我在同一张工作表中做了这个解释。在K列中得到这个的公式是：

=IFERROR(INDEX($N$2:$N$16,SUMPRODUCT(--($W$2:$W$16=MAX(--($Y$2:$Y$16="Close")*--($M$2:$M$16=A2)*$W$2:$W$16))*ROW($M$2:$M$16))-1),"NA")

此公式将返回所需的输出。应用于VBA将是：

Sub Get_Last_Closing_Date()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng2 As Range
Dim i As Long
Dim MyFormula As String

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("D:\Users\gaballahw\Desktop\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)

Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)

Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

With ws1
    For i = 3 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row Step 1
        MyFormula = "IFERROR(INDEX(" & rng2.Columns(2).Address & ",SUMPRODUCT(--(" & rng2.Columns(11).Address & _
            "=MAX(--(" & rng2.Columns(13).Address & "=""Close"")*--(" & rng2.Columns(1).Address & _
            "=" & .Range("A" & i).Value & ")*" & rng2.Columns(11).Address & "))*ROW(" & rng2.Columns(1).Address & "))-2),""NA"")" '-2 because data starts at row 3
        .Range("K" & i).Value = Evaluate(MyFormula)
    Next i
End With
 
wb2.Close SaveChanges:=False

Set rng2 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing

Application.ScreenUpdating = True
End Sub

此外，如果您有Excel365，您可能会受益于函数MAXIFS：
MAXIFS function
我很肯定，在公式中提供的部分--($W$2:$W$16=MAX(--($Y$2:$Y$16="Close")*--($M$2:$M$16=A2)*$W$2:$W$16))可以替换为MAXIFS，但我得到了一个旧版本的Excel，所以我不能测试。
此外，选中评估：
Application.Evaluate method (Excel)

排序和XLOOKUP以获得最大值

• 在Microsoft 365中，您可以在Sheet1的单元格K3中使用以下溢出公式：

=LET(sArray,Sheet2!A3:M22,sFilterCol,13,sCriteria,"Closed",sSortCols,{11;1},sSortOrders,{-1;1},sLookupCol,1,sReturnCol,2,
    dLookup,A3:A14,dNotFound,"NA",
    sSorted,SORT(FILTER(sArray,CHOOSECOLS(sArray,sFilterCol)=sCriteria),sSortCols,sSortOrders),
    sLookup,CHOOSECOLS(sSorted,sLookupCol),sReturn,CHOOSECOLS(sSorted,sReturnCol),
XLOOKUP(dLookup,sLookup,sReturn,dNotFound))

• 第1行保存源常量（7），而第2行保存目标常量（2）。
• 第3行返回经过筛选和排序的源数组。
• 在第4行中，这个修改过的数组用于获取源查找和返回列。
• 然后，这些列与目标常量一起提供给第5行中的XLOOKUP函数。
• • 编辑**
• 为了让它与您的测试文件一起工作，在Book2.xlsx打开的情况下，您需要将Sheet2!A3:M22替换为'[Book2.xlsx]Wb2-sh1'!A3:M18，将A3:A14替换为A3:A8，将Closed替换为Close（我的错）。