VBA Excel开发需求：将其他工作簿某列求和结果填充至当前文件单元格

Hey there! Let's solve this problem where you need to dynamically sum a variable-length column from another workbook and write the result to a specific cell in your current Excel file. Here's a robust, error-handled solution that works even when the target column grows over time:

Full VBA Code #

Sub SumDynamicColumnFromAnotherWorkbook()
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim lastRow As Long
    Dim sumRange As Range
    Dim currentWS As Worksheet
    Dim outputCell As Range
    
    ' ---------------------- 自定义参数，请根据实际修改 ----------------------
    Const targetFilePath As String = "C:\YourFolder\TargetWorkbook.xlsx" ' 目标工作簿的完整路径
    Const targetSheetName As String = "DataSheet" ' 目标数据所在的工作表名称
    Const targetColumn As String = "B" ' 需要求和的列（比如B列）
    Set currentWS = ThisWorkbook.Worksheets("Sheet1") ' 当前工作簿的结果存放工作表
    Set outputCell = currentWS.Range("A1") ' 要写入求和结果的单元格
    ' -----------------------------------------------------------------------
    
    On Error GoTo ErrorHandler
    
    ' 先检查目标文件是否存在，避免路径错误
    If Dir(targetFilePath) = "" Then
        MsgBox "目标工作簿不存在，请检查路径是否正确！", vbExclamation
        Exit Sub
    End If
    
    ' 后台打开目标工作簿（不显示窗口，只读模式更安全）
    Set targetWB = Workbooks.Open(Filename:=targetFilePath, ReadOnly:=True, Visible:=False)
    Set targetWS = targetWB.Worksheets(targetSheetName)
    
    ' 动态获取目标列的最后一行（自动跳过空行，找到真正的最后数据行）
    lastRow = targetWS.Cells(targetWS.Rows.Count, targetColumn).End(xlUp).Row
    
    ' 定义要求和的完整范围
    Set sumRange = targetWS.Range(targetColumn & "1:" & targetColumn & lastRow)
    
    ' 计算总和并写入指定单元格
    outputCell.Value = Application.WorksheetFunction.Sum(sumRange)
    
    ' 关闭目标工作簿，不保存（因为是只读打开）
    targetWB.Close SaveChanges:=False
    MsgBox "求和完成！结果已写入 " & outputCell.Address, vbInformation
    
    Exit Sub
    
ErrorHandler:
    MsgBox "执行出错：" & Err.Description, vbCritical
    ' 确保出错时目标工作簿也能正常关闭，避免后台残留
    If Not targetWB Is Nothing Then
        targetWB.Close SaveChanges:=False
    End If
End Sub

Key Details & Customization Tips #

• Dynamic Last Row Detection: The line lastRow = targetWS.Cells(targetWS.Rows.Count, targetColumn).End(xlUp).Row is the star here. It starts at the very bottom of the column and moves up to the first non-empty cell, so it automatically adapts if you add more rows to the target column later.
• Background Workbook Handling: Using Visible:=False opens the target workbook in the background so it doesn't disrupt your workflow, and ReadOnly:=True prevents accidental edits to the source file.
• Error Handling: The error trap catches common issues like missing files, typos in sheet names, or broken ranges. It also ensures the target workbook gets closed even if something goes wrong.
• Adjust for Headers: If your target column has a header row, modify the sumRange to start at row 2 instead of row 1:

  Set sumRange = targetWS.Range(targetColumn & "2:" & targetColumn & lastRow)
  

• Flexible File Selection: Instead of hardcoding the file path, let users pick the target workbook interactively:

  Dim targetFilePath As Variant
  targetFilePath = Application.GetOpenFilename("Excel Files (*.xlsx;*.xls), *.xlsx;*.xls")
  If targetFilePath = False Then Exit Sub ' 用户取消选择时退出
  

Bonus: Check if Target Workbook is Already Open #

If the target workbook might be open already, add this check to avoid opening a duplicate:

' 先检查目标工作簿是否已打开
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks("TargetWorkbook.xlsx") ' 这里用文件名，不是完整路径
On Error GoTo 0
If wb Is Nothing Then
    Set targetWB = Workbooks.Open(Filename:=targetFilePath, ReadOnly:=True, Visible:=False)
Else
    Set targetWB = wb
End If

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