如何实现跨工作表无序System_ID的Index-Match匹配？VBA求助

Got it, let's tackle this problem head-on. The core issue with your current code is that it only compares rows with the same index number between the two sheets—so if the same System_ID lives in different rows, it gets completely ignored.

The best fix here is to use a Dictionary (a key-value pair structure) where we use System_ID as the unique key, and store the latest Last Modified Time and corresponding Comment for each ID. This way, row positions don't matter—we just track the most recent entry for every System_ID across both sheets.

Step-by-Step Breakdown #

1. Use a Dictionary: This lets us map each System_ID to its latest timestamp and comment, ensuring we only keep the most up-to-date entry.
2. Load Data from Both Sheets: First we iterate through User1's data, then User2's. For each entry, we check if the System_ID already exists in the dictionary. If it does, we compare timestamps and update if the new entry is newer. If not, we add it to the dictionary.
3. Write Results to the Result Sheet: Once we've processed all entries from both sheets, we dump the dictionary's contents into the Result sheet, pairing each System_ID with its latest comment.

Modified VBA Code #

Sub Get_LastModified_Here()
    Application.EnableEvents = False
    Application.ScreenUpdating = False ' Speed up code by disabling screen updates
    
    Dim wbUser1 As Workbook, wbUser2 As Workbook, wbResult As Workbook
    Dim wsUser1 As Worksheet, wsUser2 As Worksheet, wsResult As Worksheet
    Dim lastRowUser1 As Long, lastRowUser2 As Long, outputRow As Long
    Dim dict As Object ' Dictionary to track latest System_ID data
    Dim sysID As String, currentComment As String, currentTime As Date
    Dim i As Long
    
    ' Set workbook/worksheet references
    Set wbUser1 = GetWorkbook("C:\Users\HP\Desktop\User_1.xlsb")
    Set wsUser1 = wbUser1.Sheets("Data")
    Set wbUser2 = GetWorkbook("C:\Users\HP\Desktop\User_2.xlsb")
    Set wsUser2 = wbUser2.Sheets("Data")
    Set wbResult = ThisWorkbook
    Set wsResult = wbResult.Sheets("Data") ' Adjust sheet name if your "result" sheet has a different name
    
    ' Initialize dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' Make System_ID comparisons case-insensitive (optional)
    
    ' Process User1's data
    lastRowUser1 = wsUser1.Cells(wsUser1.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowUser1 ' Start at row 2 to skip header row
        sysID = Trim(wsUser1.Cells(i, "A").Value)
        If sysID <> "" Then ' Skip blank System_ID entries
            currentComment = wsUser1.Cells(i, "B").Value
            currentTime = wsUser1.Cells(i, "C").Value
            
            ' Add to dictionary if new, or update if timestamp is newer
            If Not dict.Exists(sysID) Then
                dict.Add sysID, Array(currentTime, currentComment)
            Else
                If currentTime > dict(sysID)(0) Then
                    dict(sysID) = Array(currentTime, currentComment)
                End If
            End If
        End If
    Next i
    
    ' Process User2's data (same logic, update existing entries if newer)
    lastRowUser2 = wsUser2.Cells(wsUser2.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowUser2
        sysID = Trim(wsUser2.Cells(i, "A").Value)
        If sysID <> "" Then
            currentComment = wsUser2.Cells(i, "B").Value
            currentTime = wsUser2.Cells(i, "C").Value
            
            If Not dict.Exists(sysID) Then
                dict.Add sysID, Array(currentTime, currentComment)
            Else
                If currentTime > dict(sysID)(0) Then
                    dict(sysID) = Array(currentTime, currentComment)
                End If
            End If
        End If
    Next i
    
    ' Clear existing result data (keep header row intact)
    wsResult.Range("A2:C" & wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' Write dictionary data to Result sheet
    outputRow = 2
    For Each key In dict.Keys
        wsResult.Cells(outputRow, "A").Value = key
        wsResult.Cells(outputRow, "B").Value = dict(key)(1)
        wsResult.Cells(outputRow, "C").Value = dict(key)(0)
        outputRow = outputRow + 1
    Next key
    
    ' Cleanup objects to free memory
    Set dict = Nothing
    Set wsUser1 = Nothing: Set wbUser1 = Nothing
    Set wsUser2 = Nothing: Set wbUser2 = Nothing
    Set wsResult = Nothing: Set wbResult = Nothing
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "Latest comments updated successfully!", vbInformation
End Sub

' Helper function to get workbook (opens if not already open)
Function GetWorkbook(ByVal filePath As String) As Workbook
    Dim wb As Workbook
    On Error Resume Next
    Set wb = Workbooks(Filename:=filePath)
    On Error GoTo 0
    If wb Is Nothing Then
        Set wb = Workbooks.Open(filePath, ReadOnly:=True) ' Open as read-only to avoid file locking
    End If
    Set GetWorkbook = wb
End Function

Key Improvements Over Your Original Code #

• Dictionary-Based Matching: No longer tied to row positions—every System_ID is tracked uniquely, regardless of where it appears in either sheet.
• Dynamic Range Detection: Uses End(xlUp) to find the last row of data instead of hardcoding A1607, so it works even if your dataset grows or shrinks.
• Robust Workbook Handling: The GetWorkbook function opens files if they're not already open, and uses read-only mode to prevent file locking issues.
• Optional Case Insensitivity: dict.CompareMode = vbTextCompare ensures ID_1 and id_1 are treated as the same (remove this line if you need case-sensitive matching).

Example Test Case #

For your sample data:

User1 row 1: ID_1 | User1 notes | 09/12/2020 10:00:01 PM
User2 row 2: ID_1 | User2 notes | 09/12/2020 10:00:02 PM

The code will:

1. Add ID_1 to the dictionary from User1
2. When processing User2's ID_1, it detects the newer timestamp and updates the dictionary to store User2's comment and timestamp
3. Writes ID_1 | User2 notes | 09/12/2020 10:00:02 PM to the Result sheet

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