VBA代码问题：检查工作簿多单元格字符串与另一工作簿行的匹配

Let's walk through the issues in your current code and fix them to get the matching working correctly:

Key Problems in the Original Code #

• Assigning entire columns to variables: When you do R1 = x.Sheets(j).Range("d:d").Value, you're storing a 2D array (since it's an entire column) instead of individual cell values. You can't compare a single cell value (like FS1) to an entire column array directly.
• Incorrect loop logic: Your j variable is looping through sheet indices, not rows in the target workbook. You need to loop through each row in the target sheet(s) to check for matches, not each sheet.
• Typos in match conditions: You have duplicate FS6 = R6 checks, which is a mistake—you meant to map each FS variable to its corresponding R column (FS5 to R5, FS6 to R6, FS7 to R7).
• On Error Resume Next hiding issues: This statement suppresses error messages, so you can't see if the target workbook fails to open, or if cells are missing values. It's better to handle errors explicitly instead of hiding them.
• Undefined variables: You didn't declare variables like i, j, FS1-FS7, R1-R7—always use Option Explicit at the top to catch typos and undefined variables.
• Wrong row reference in MsgBox: You're using j (sheet index) to reference rows like Range("d" & j), which is completely incorrect—you need a separate row variable for iterating through rows.

Corrected VBA Code #

Option Explicit ' Forces variable declaration, catches typos

Sub CheckCustomerID()
    Dim targetWB As Workbook ' Source workbook (the one you're checking)
    Dim lookupWB As Workbook ' Workbook with project tracker data
    Dim targetWS As Worksheet
    Dim lookupWS As Worksheet
    Dim lastRow As Long
    Dim rowNum As Long
    Dim matchFound As Boolean
    
    ' Declare all your value variables
    Dim FS1 As String, FS2 As String, FS3 As String
    Dim FS4 As String, FS5 As String, FS6 As String, FS7 As String
    
    ' Try to open the lookup workbook with error handling
    On Error GoTo ErrorHandler
    Set lookupWB = Workbooks.Open("\\Eng_badia-pc\e\WALEED SOBEH ENGINEERING OFFICE\W-01-ADMINSTRATIVE DEPARTMENT\W-01-AD-1-SALES\W-01-D1-S1-STATMENTS\03-PROJECTS TRACKER.xlsm")
    Set targetWB = ActiveWorkbook
    
    ' Loop through each sheet in the source workbook
    For Each targetWS In targetWB.Sheets
        ' Get values from the source sheet (adjust ranges if needed)
        FS1 = Trim(targetWS.Range("B3").Value2)
        FS2 = Trim(targetWS.Range("B6").Value2)
        FS3 = Trim(targetWS.Range("E6").Value2)
        FS4 = Trim(targetWS.Range("H6").Value2)
        FS5 = Trim(targetWS.Range("B7").Value2)
        FS6 = Trim(targetWS.Range("H7").Value2)
        FS7 = Trim(targetWS.Range("E7").Value2)
        
        ' Skip if any critical value is empty (adjust based on your needs)
        If FS1 = "" Or FS2 = "" Then
            MsgBox "Missing critical values in " & targetWS.Name & ", skipping sheet.", vbExclamation
            GoTo NextTargetSheet
        End If
        
        matchFound = False
        
        ' Loop through each sheet in the lookup workbook
        For Each lookupWS In lookupWB.Sheets
            ' Find the last used row in column D to avoid looping the entire column
            lastRow = lookupWS.Cells(lookupWS.Rows.Count, "D").End(xlUp).Row
            
            ' Loop through each row in the lookup sheet (start at row 2 if there's a header)
            For rowNum = 2 To lastRow
                ' Get values from the current lookup row
                Dim R1 As String, R2 As String, R3 As String
                Dim R4 As String, R5 As String, R6 As String, R7 As String
                
                R1 = Trim(lookupWS.Range("D" & rowNum).Value2)
                R2 = Trim(lookupWS.Range("M" & rowNum).Value2)
                R3 = Trim(lookupWS.Range("N" & rowNum).Value2)
                R4 = Trim(lookupWS.Range("O" & rowNum).Value2)
                R5 = Trim(lookupWS.Range("P" & rowNum).Value2)
                R6 = Trim(lookupWS.Range("Q" & rowNum).Value2)
                R7 = Trim(lookupWS.Range("R" & rowNum).Value2)
                
                ' Check if all values match
                If FS1 = R1 And FS2 = R2 And FS3 = R3 And _
                   FS4 = R4 And FS5 = R5 And FS6 = R6 And FS7 = R7 Then
                    matchFound = True
                    ' Show match details
                    MsgBox "Match found for Customer: " & R1 & vbNewLine & _
                           "Customer ID: " & lookupWS.Range("B" & rowNum).Value2, vbInformation
                    ' Rename the source sheet to the Customer ID (adjust range if needed)
                    targetWS.Name = lookupWS.Range("B" & rowNum + 3).Value2
                    Exit For ' Exit row loop once match is found
                End If
            Next rowNum
            
            If matchFound Then Exit For ' Exit sheet loop once match is found
        Next lookupWS
        
        ' If no match found across all sheets/rows
        If Not matchFound Then
            MsgBox "No match found for " & targetWS.Name & " - New Customer.", vbInformation
        End If
        
NextTargetSheet:
    Next targetWS
    
    ' Cleanup
    lookupWB.Close SaveChanges:=False ' Close lookup workbook without saving
    Exit Sub
    
ErrorHandler:
    MsgBox "Error opening lookup workbook: " & Err.Description, vbCritical
    Exit Sub
End Sub

What Changed & Why #

1. Option Explicit: Added at the top to prevent typos and undefined variables—this is a best practice for all VBA code.
2. Proper variable naming: Changed y/x to targetWB/lookupWB for clarity, so you know which workbook is which.
3. Row iteration: Added rowNum to loop through each row in the lookup sheets, instead of looping through sheets with j (which was wrong).
4. Trimmed values: Used Trim() to remove extra spaces that might cause false mismatches, and Value2 instead of Value for faster, more reliable value retrieval.
5. Error handling: Replaced On Error Resume Next with a proper error handler to catch issues like missing files.
6. Early exit loops: Once a match is found, we exit the row and sheet loops to save time instead of checking every row/sheet unnecessarily.
7. Last row calculation: Instead of looping the entire column (which is slow), we find the last used row in column D to limit the loop to only relevant rows.
8. Fixed match conditions: Corrected the duplicate FS6 = R6 checks to map each FS variable to its correct R column.

Notes #

• If your lookup sheets have headers, start rowNum at 2 (like in the code) to skip the header row. If there are no headers, start at 1.
• Adjust the range references (like lookupWS.Range("B" & rowNum) for Customer ID) if your data is in different columns.
• The code closes the lookup workbook without saving—change SaveChanges:=False to True if you need to save changes to it.

内容的提问来源于stack exchange，提问作者M.AlAbsi