Excel宏开发需求：跨工作簿匹配打印机信息并复制对应值

Got it, let's tackle this problem step by step. Here's a robust VBA macro that does exactly what you need, with clear comments to walk you through each part:

Sub CopyPrinterDataToInk()
    Dim inkWB As Workbook
    Dim printersWB As Workbook
    Dim inkWS As Worksheet
    Dim printersWS As Worksheet
    Dim lastRowInk As Long
    Dim lastRowPrinters As Long
    Dim i As Long
    Dim matchValue As Variant
    Dim matchRow As Variant
    
    ' Set reference to the current Ink workbook (the one running the macro)
    Set inkWB = ThisWorkbook
    ' Replace "Toner Counts" with your actual sheet name in Ink.xlsm if needed
    Set inkWS = inkWB.Sheets("Toner Counts")
    
    ' Open the Printers workbook using the exact file path
    On Error Resume Next
    Set printersWB = Workbooks.Open("C:\Users\admin\Desktop\printers.xlsm")
    On Error GoTo 0
    
    ' Check if the Printers workbook opened successfully
    If printersWB Is Nothing Then
        MsgBox "Could not open Printers.xlsm. Double-check the file path and try again.", vbExclamation
        Exit Sub
    End If
    
    ' Replace "Printer List" with your actual sheet name in Printers.xlsm if needed
    Set printersWS = printersWB.Sheets("Printer List")
    
    ' Get the last row with data in Ink's column B (toner counts)
    lastRowInk = inkWS.Cells(inkWS.Rows.Count, "B").End(xlUp).Row
    ' Get the last row with data in Printers' column H (matching values)
    lastRowPrinters = printersWS.Cells(printersWS.Rows.Count, "H").End(xlUp).Row
    
    ' Loop through each row in Ink's column B starting from row 2 (skip header)
    For i = 2 To lastRowInk
        matchValue = inkWS.Cells(i, "B").Value
        
        ' Skip empty cells to avoid unnecessary searches
        If matchValue <> "" Then
            ' Look for the matching value in Printers' column H (starting at row 2)
            matchRow = Application.Match(matchValue, printersWS.Range("H2:H" & lastRowPrinters), 0)
            
            ' If a match is found...
            If Not IsError(matchRow) Then
                ' Copy the value from 2 columns left of H (column F) to Ink's corresponding row
                ' Change "C" to your target column in Ink.xlsm if needed
                inkWS.Cells(i, "C").Value = printersWS.Cells(matchRow + 1, "H").Offset(0, -2).Value
            Else
                ' Optional: Handle cases where no match is found (customize this as needed)
                inkWS.Cells(i, "C").Value = "No Match Found"
            End If
        End If
    Next i
    
    ' Close the Printers workbook (set SaveChanges:=True if you need to save edits)
    printersWB.Close SaveChanges:=False
    
    MsgBox "Data transfer completed successfully!", vbInformation
End Sub

Key Notes & Customization Tips: #

• Sheet Names: Replace "Toner Counts" and "Printer List" with the actual sheet names in your workbooks. If you're unsure, check the tab name at the bottom of Excel.
• Target Column: The macro copies data to column C in Ink.xlsm—change "C" to whatever column you need the data to go into.
• No Match Handling: The code currently puts "No Match Found" for missing values. You can remove this line to leave cells blank instead.
• Error Safety: The macro checks if Printers.xlsm opens correctly, so you'll get a clear message if the path is wrong.

How to Use: #

1. Open Ink.xlsm
2. Press Alt + F11 to open the VBA Editor
3. Right-click your workbook in the Project Explorer > Insert > Module
4. Paste the code into the new module
5. Adjust the sheet names/target column if needed
6. Run the macro by pressing F5, or go back to Excel, click the Developer tab > Macros > select CopyPrinterDataToInk > Run

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