如何通过VBA实现VLOOKUP多列取值并自动换行填充？

首先，你的原代码有两个核心问题：一是每次都固定写入I6:L6，没有自动定位到下一个空行；二是使用VLOOKUP数组公式配合AutoFill的方式在VBA里执行不够稳定，而且会保留公式依赖（如果后续L2的值改变，之前填充的内容也会跟着变，这可能不是你想要的）。

下面是两种优化后的解决方案，你可以根据需求选择：

方案1：使用VLOOKUP函数获取静态值 #

这个方案会把匹配到的静态值写入目标行，避免公式依赖，同时自动定位下一个空行：

Sub getValues()
    Dim ws As Worksheet
    Dim lookupValue As Variant
    Dim nextRow As Long
    Dim resultRange As Variant
    
    ' 设置工作表（根据你的实际表名修改，比如Sheet1）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取L2的查找值
    lookupValue = ws.Range("L2").Value
    If IsEmpty(lookupValue) Then
        MsgBox "请先在L2选择一个姓名！", vbExclamation
        Exit Sub
    End If
    
    ' 找到I列下一个空行（确保从I6开始）
    nextRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row + 1
    If nextRow < 6 Then nextRow = 6 ' 如果I6及以上都是空的，从I6开始
    
    On Error Resume Next ' 捕获VLOOKUP找不到匹配值的错误
    ' 一次性获取Name、ID、DOB、Email对应的值
    resultRange = Application.WorksheetFunction.VLookup( _
        lookupValue, ws.Range("A5:E12"), Array(1, 2, 4, 5), False)
    On Error GoTo 0
    
    If IsEmpty(resultRange) Then
        MsgBox "未找到匹配的记录！", vbExclamation
        Exit Sub
    End If
    
    ' 将结果写入目标行的I到L列
    ws.Range("I" & nextRow & ":L" & nextRow).Value = resultRange
    
    ' 可选：将焦点移回L2，方便下次选择
    ws.Range("L2").Select
End Sub

方案2：使用Find方法精准查找匹配行 #

如果你的数据可能有重复姓名，或者需要更精准的查找逻辑，用Find方法会更可靠：

Sub getValuesWithFind()
    Dim ws As Worksheet
    Dim lookupValue As Variant
    Dim nextRow As Long
    Dim matchCell As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lookupValue = ws.Range("L2").Value
    
    If IsEmpty(lookupValue) Then
        MsgBox "请先在L2选择一个姓名！", vbExclamation
        Exit Sub
    End If
    
    ' 查找A列中匹配L2值的单元格（精确匹配）
    Set matchCell = ws.Range("A5:A12").Find( _
        What:=lookupValue, LookIn:=xlValues, LookAt:=xlWhole)
    
    If matchCell Is Nothing Then
        MsgBox "未找到匹配的记录！", vbExclamation
        Exit Sub
    End If
    
    ' 定位下一个空行
    nextRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row + 1
    If nextRow < 6 Then nextRow = 6
    
    ' 从匹配行提取对应列的值，写入目标行
    ws.Range("I" & nextRow).Value = matchCell.Value ' Name（A列）
    ws.Range("J" & nextRow).Value = matchCell.Offset(0, 1).Value ' ID（B列）
    ws.Range("K" & nextRow).Value = matchCell.Offset(0, 3).Value ' DOB（D列）
    ws.Range("L" & nextRow).Value = matchCell.Offset(0, 4).Value ' Email（E列）
    
    ws.Range("L2").Select
End Sub

关键改进点说明： #

• 自动定位空行：通过Cells(Rows.Count, "I").End(xlUp).Row + 1找到I列最后一个非空行的下一行，确保每次点击都写入新行
• 静态值写入：直接把匹配结果作为值写入单元格，而非公式，避免后续L2值改变影响之前的填充内容
• 错误处理：增加了空值检查和匹配失败的提示，提升用户体验
• 明确工作表：指定操作的工作表，避免切换工作表时出现错误

你可以根据自己的数据结构调整代码中的列偏移或范围，测试后就能实现预期功能了！

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