VBA：无论索引排序如何，都匹配结果？

Question

我有 3 个工作表（user1、user2、result）。每张表有三列（A：System_ID，B：评论，C：上次修改时间）。

代码是这样做的：

1. 获取 c 列中 user1 和 user2 之间的最大上次修改时间。
2. 结果是在 b 列中获得该评论（与 c 列中找到的最大时间相邻）
3. 将结果（注释）放在结果表的 b 列中

仅以最后修改时间为准，并粘贴到结果 WS 中。

无论如何，我的问题是，如果 A 列中的两个索引具有相同的排序/顺序，我只能进行索引匹配。

我需要匹配 A 列中的所有记录，即使它们具有不同的 row.number 或行索引。

无论A列的顺序如何，如何进行索引匹配

        Sub Get_LastModified_Here()
        
        Application.EnableEvents = False
        
        Dim Location1 As Workbook
        Set Location1 = GetWorkbook("C:\Users\HP\Desktop\User_1.xlsb")
        Dim Location2 As Workbook
        Set Location2 = GetWorkbook("C:\Users\HP\Desktop\User_2.xlsb")
        
        Dim SourceCell As Range, SourceRange As Range, CurrentRange As Range
        Dim rngTarget As Range
        Dim strAdr As String
        Dim vSource As Variant, vTarget As Variant, vCurrent As Variant
        Dim i As Long
        
        Set SourceRange = Workbooks("User_2.xlsb").Sheets("Data").Range("A2:" & "A1607")
        
        With SourceRange
            Set SourceRange = .Resize(.Rows.Count, .Columns.Count + 3)
        End With
        
        strAdr = SourceRange.Address
        
        Set rngTarget = Workbooks("User_1.xlsb").Worksheets("Data").Range(strAdr)
        
        Set CurrentRange = ThisWorkbook.Worksheets("Data").Range(strAdr).Offset(0, 1)
        
        vSource = SourceRange
        vTarget = rngTarget
        vCurrent = CurrentRange
        
        
        For i = 1 To UBound(vSource, 1)
             'Match Column A
             If vSource(i, 1) = vTarget(i, 1) Then
                'Check max time in Column C (user1 vs user2)
                 If vSource(i, 3) > vTarget(i, 3) Then
                    'Get max comment from ((user max)) in column B  (result ws)
                    vCurrent(i, 1) = vSource(i, 2)
                    
                ElseIf vSource(i, 3) < vTarget(i, 3) Then
                    vCurrent(i, 1) = vTarget(i, 2)
                ElseIf vSource(i, 3) = vTarget(i, 3) Then
                    vCurrent(i, 1) = vSource(i, 2)
                End If
            End If
        Next i
        
        SourceRange = vSource
        rngTarget = vTarget
        CurrentRange = vCurrent
        
        Application.EnableEvents = True
        
    End Sub             

这里是问题的详细解释（我对大写字母表示歉意）：

用户 1 表

我在## 第 1 行 ##

中有 SYSTEM_ID

System_ID	Comment	LastModTime
ID_1	User1 notes	09/12/2020 10:00:01 PM

用户 2 表

我在## 第 2 行 ##

中有 SAME SYSTEM_ID

System_ID	Comment	LastModTime
ID_1	User2 notes	09/12/2020 10:00:02 PM

这是我在结果表中得到的

我有 SAME SYSTEM_ID 但在 ## 第 3 行 ##

System_ID	Comment	LastModTime
ID_1

这就是我想要的结果表

我有 SAME SYSTEM_ID 但在 ## 第 3 行 ##

System_ID	Comment	LastModTime
ID_1	User2 notes	09/12/2020 10:00:02 PM

我们的代码可以做什么

根据上次修改时间获取评论，仅当“ID_1”在同一行 # 时。我已经尝试过（没用）

我们的代码不能做什么

根据上次修改时间获取评论，即使“ID_1”位于 A DIFFERENT ROW # 上。这是我需要帮助的地方吗？

Answer 1

编辑以确认假设匹配：

工作表用户 1： |身份证 |评论 |最后模组 | | --- | -------- | --------| | 3 | S1 通讯3| 2 | | 2 | S1 通讯2| 8 | | 1 | S1 通讯1| 6 |

工作表用户 2： |身份证 |评论 |最后模组 | | --- | -------- | --------| | 1 | S2 通讯1| 3 | | 2 | S2 通讯2| 4 | | 3 | S2 通讯3| 8 |

预期输出：

Id	Comment	NOTES
1	S1 Comm1	Id 1 highest mod is on sheet 1
2	S1 Comm2	Id 2 highest mod is on sheet 2
3	S2 Comm3	Id 3 highest mod is on sheet 3

一种选择是将结果集构建到一个单独的集合中，然后在完成后填充您的结果集。由于这是一个涉及多次查找的操作（检查系统 ID 是否已被访问），我喜欢使用字典对象。它们提供高性能的查找操作。

我将在下面发布一个非常简化的示例，希望您可以将其用于您的目的。下面的代码假定 SystemId 列是唯一键，它将 sheet1 中的条目映射到 sheet2 中的条目。它还假设每个 systemId 在每张纸上出现一次。如果没有，可以对其进行调整以支持它。

代码基本上循环遍历范围并检查两个工作表中的行是否具有匹配的系统 ID。如果是这样，它会将该行添加到字典中，使用 ID 作为键，以及包含评论和最后修改时间的两元素数组。

如果它们不匹配，它会根据字典检查每个条目，以查看该 systemID 是否已被访问（在另一张表的前面）。如果是，它会比较条目并保留最近的 mod 时间，否则，它会保持原样。

尝试解决它，如果您需要其他帮助，请告诉我们。

Sub Tester()
    Dim oDict As Object
    Dim a(0 To 1)
    Dim sUser1 As Worksheet
    Dim sUser2 As Worksheet
    
    Set oDict = CreateObject("Scripting.Dictionary")
    Set sUser1 = Sheets("User1")
    Set sUser2 = Sheets("User2")
    
    'Here I will assume that both ranges will always
    'be the same length. I'm also hardcoding in the
    'needed rows. You can use whichever logic
    'works best for you to determine how to capture
    'all rows in both sheets
    For i = 2 To 8
        'Two possibilities here:
        '   1. The SystemId in both sheets match and
        '      can be directly compared
        '   2. They differ and will each be checked
        '      to see if they already exist in the dict.
        'You can bypass this and just treat each of the
        'ranges individually, but I think it would be
        'slightly more performant the way I'm doing it.
        '
        'Also, this assumes that each SystemId will only
        'appear once in each sheet, and is a true Primary Key
        If sUser1.Cells(i, 1).Value = sUser2.Cells(i, 1) Then
            If sUser1.Cells(i, 3).Value > sUser2.Cells(i, 3).Value Then
                MergeEntryToDictionary oDict, sUser1.Cells(i, 1).Value, _
                    sUser1.Cells(i, 2).Value, sUser1.Cells(i, 3).Value
            Else
                MergeEntryToDictionary oDict, sUser2.Cells(i, 1).Value, _
                    sUser2.Cells(i, 2).Value, sUser2.Cells(i, 3).Value
            End If
        Else
            'In case they don't match, check each entry against the
            'dictionary to see if the systemId has already been added.
            'If not, then add it. Otherwise, compare the last mod date
            'of the entry to the current, and update if needed.
            MergeEntryToDictionary oDict, sUser1.Cells(i, 1).Value, _
                    sUser1.Cells(i, 2).Value, sUser1.Cells(i, 3).Value
            
            MergeEntryToDictionary oDict, sUser2.Cells(i, 1).Value, _
                    sUser2.Cells(i, 2).Value, sUser2.Cells(i, 3).Value
        End If
    Next i
    
    'Below prints back to sheet
    Dim k As Variant
    Dim n As Long
    n = 2
    For Each k In oDict.keys
        Sheets("result").Cells(n, 1).Value = k
        Sheets("result").Cells(n, 2).Value = oDict(k)(0)
        Sheets("result").Cells(n, 3).Value = oDict(k)(1)
        
        n = n + 1
    Next k
End Sub

Function MergeEntryToDictionary(ByRef oDict As Object, _
                                SystemId As String, _
                                sComment As String, _
                                LastModTime As Double) As Boolean
    Dim a(0 To 2)
    
    If oDict.exists(SystemId) Then
        If LastModTime > oDict(SystemId)(1) Then
            a(0) = sComment
            a(1) = LastModTime
            oDict(SystemId) = a
        End If
    Else
        a(0) = sComment
        a(1) = LastModTime
        
        oDict.Add SystemId, a
    End If
    
    MergeEntryToDictionary = True
End Function