基于行标题名称跨工作簿复制行数据的VBA实现咨询

Got it, let's break down how to turn your existing macro into a clean, reusable function while keeping your core mapping goals intact. First, let's recap your key requirements to make sure the solution aligns:

• Use the "Test" sheet mapping (Column A = target row names, Column B = source row names)
• Match source rows (names in Column 2) to non-continuous target rows (names in Column 1)
• Copy matching source data to the target workbook, skipping unmapped rows

Step 1: Build the Core Mapping Function #

We'll create a function that handles the heavy lifting of matching and copying data. It returns a boolean to signal success/failure, making it easy to integrate with other code and handle errors cleanly.

Function MapSourceToTarget(ByVal targetWB As Workbook, ByVal targetSheetName As String, _
                          ByVal sourceWB As Workbook, ByVal sourceSheetName As String, _
                          ByVal mappingSheet As Worksheet) As Boolean
    Dim targetWS As Worksheet, sourceWS As Worksheet
    Dim mappingRange As Range, mapRow As Range
    Dim targetMatchRow As Range, sourceMatchRow As Range
    Dim lastMapRow As Long, lastSourceCol As Long
    
    ' Enable error trapping to catch issues like missing sheets
    On Error GoTo ErrorHandler
    
    ' Set references to our worksheets
    Set targetWS = targetWB.Worksheets(targetSheetName)
    Set sourceWS = sourceWB.Worksheets(sourceSheetName)
    
    ' Get the full mapping range (skip the header row)
    lastMapRow = mappingSheet.Cells(mappingSheet.Rows.Count, 1).End(xlUp).Row
    Set mappingRange = mappingSheet.Range("A2:B" & lastMapRow)
    
    ' Get the last column with data in the source sheet
    lastSourceCol = sourceWS.Cells(1, sourceWS.Columns.Count).End(xlToLeft).Column
    
    ' Loop through each entry in the mapping table
    For Each mapRow In mappingRange.Rows
        ' Find the target row by its name (Column 1 of target sheet)
        Set targetMatchRow = targetWS.Columns(1).Find(What:=mapRow.Cells(1, 1).Value, _
                                                    LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not targetMatchRow Is Nothing Then
            ' Find the corresponding source row by its name (Column 2 of source sheet)
            Set sourceMatchRow = sourceWS.Columns(2).Find(What:=mapRow.Cells(1, 2).Value, _
                                                      LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not sourceMatchRow Is Nothing Then
                ' Copy source row data to the target row (adjust columns as needed)
                sourceWS.Range(sourceMatchRow.Cells(1, 2), sourceMatchRow.Cells(1, lastSourceCol)).Copy _
                Destination:=targetWS.Cells(targetMatchRow.Row, 2)
            Else
                Debug.Print "Warning: Source row not found - " & mapRow.Cells(1, 2).Value
            End If
        Else
            Debug.Print "Warning: Target row not found - " & mapRow.Cells(1, 1).Value
        End If
    Next mapRow
    
    MapSourceToTarget = True ' Return success status
    Exit Function
    
ErrorHandler:
    MsgBox "Error during mapping: " & Err.Description, vbCritical
    MapSourceToTarget = False ' Return failure status
End Function

Step 2: Create a Calling Subroutine #

VBA functions can't be directly run from the macro menu, so we'll make a subroutine that handles user input (file selection) and triggers our function. This keeps the user-facing logic separate from the core mapping.

Sub RunMappingWorkflow()
    Dim defaultDir As String
    Dim userChoice As VbMsgBoxResult
    Dim sourceWB As Workbook
    Dim targetWB As Workbook
    Dim mappingSheet As Worksheet
    Dim selectedSourceFile As Variant
    
    ' Set your default directory here
    defaultDir = "C:\Your\Default\File\Path\"
    Set targetWB = ThisWorkbook
    Set mappingSheet = targetWB.Worksheets("Test")
    
    ' Prompt user for file selection
    userChoice = MsgBox("Want to select a specific source file? Click Yes to browse, Cancel to exit.", _
                       vbYesCancel + vbQuestion, "Source File Selection")
    
    If userChoice = vbYes Then
        ' Let user pick the source workbook
        selectedSourceFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*", _
                                                        Title:="Select Source Workbook")
        If selectedSourceFile = False Then Exit Sub ' User canceled selection
        
        ' Open the source workbook (read-only to avoid accidental edits)
        Set sourceWB = Workbooks.Open(selectedSourceFile, UpdateLinks:=0, ReadOnly:=True)
        
        ' Disable Excel features for faster performance
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .Calculation = xlCalculationManual
        End With
        
        ' Call our mapping function and handle results
        If MapSourceToTarget(targetWB, "Data Cost Estimate", sourceWB, "EST Actuals", mappingSheet) Then
            targetWB.Save
            MsgBox "Mapping completed successfully!", vbInformation
        Else
            MsgBox "Mapping failed. Check the debug window for details.", vbExclamation
        End If
        
        ' Clean up and restore Excel settings
        sourceWB.Close SaveChanges:=False
        With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
            .Calculation = xlCalculationAutomatic
            .CutCopyMode = False
        End With
    ElseIf userChoice = vbCancel Then
        MsgBox "Process canceled.", vbInformation
        Exit Sub
    End If
End Sub

Key Improvements & Notes #

• Modularity: The MapSourceToTarget function focuses only on mapping logic, so you can reuse it in other macros without rewriting code.
• Error Handling: Traps errors like missing sheets or invalid file paths, with clear feedback for troubleshooting.
• Robust Matching: Uses Range.Find to locate rows, which works reliably even with non-continuous target rows.
• Performance: Disables screen updating and automatic calculation during the process to speed up large datasets.
• Debugging: Includes Debug.Print statements to log missing rows, so you can fix mapping issues quickly.

How to Use #

1. Update the defaultDir path in RunMappingWorkflow to your actual default directory.
2. Ensure your "Test" sheet has the mapping table (Column A = target row names, Column B = source row names) with a header row.
3. Run the RunMappingWorkflow macro from the VBA editor or assign it to a button in Excel.

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