如何用VBA实现批量XLOOKUP填充？替代Excel拖拽公式操作

修改后的完整代码 #

Sub ImportBaselineData()
    Dim FileLocation As String
    FileLocation = Application.GetOpenFilename
    
    If FileLocation = "False" Then
        Beep
        Exit Sub
    End If
    
    Dim ImportWorkbook As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowC As Long
    Dim lastRowSourceH As Long
    Dim searchedColumn As Range
    Dim returnedValue As Range
    Dim targetRange As Range
    
    Application.ScreenUpdating = False
    
    '打开外部工作簿并指定工作表
    Set ImportWorkbook = Workbooks.Open(Filename:=FileLocation)
    Set wsSource = ImportWorkbook.Worksheets(1)
    Set wsTarget = ThisWorkbook.Worksheets("Overall Analysis")
    
    '获取外部工作簿H列的有效数据范围
    lastRowSourceH = wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp).Row
    Set searchedColumn = wsSource.Range("H9:H" & lastRowSourceH)
    Set returnedValue = wsSource.Range("H9:H" & lastRowSourceH) '可根据实际需求修改返回列
    
    '获取目标工作表C列从C9开始的最后一行
    lastRowC = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
    
    '判断是否有需要填充的行
    If lastRowC >= 9 Then
        Set targetRange = wsTarget.Range("Y9:Y" & lastRowC)
        
        '方式一：写入XLOOKUP公式（保留公式，和Excel拖拽效果一致）
        targetRange.Formula = "=XLOOKUP(C" & 9 & ", '" & wsSource.Name & "'!" & searchedColumn.Address & ", '" & wsSource.Name & "'!" & returnedValue.Address & ")"
        
        '方式二：直接填充计算结果（不保留公式，只存数值）
        'targetRange.Value = Application.XLookup(wsTarget.Range("C9:C" & lastRowC), searchedColumn, returnedValue)
    End If
    
    ImportWorkbook.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub

关键改动说明 #

• 明确工作表对象：原代码中未指定Range("H9").End(xlDown)所属工作表，容易引发上下文错误，修改后通过wsSource明确指向外部工作簿的第一个工作表，避免歧义。
• 批量范围获取：通过lastRowC获取C列从C9开始的最后一行，确定Y列需要填充的目标范围Y9:Y[lastRowC]。
• 两种填充模式：
  • 方式一写入公式，和手动拖拽公式的效果完全一致，单元格保留公式可后续自动更新；
  • 方式二直接计算结果并写入数值，适合不需要保留公式的场景，执行效率更高。
• 批量查询优化：原代码仅处理单个单元格的查询值，修改后直接用目标范围的C列整列作为查询值，配合XLOOKUP的数组特性实现批量计算。

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