关于使用Application.Match函数匹配列后实现数据粘贴的VBA技术求助

嘿，我来帮你搞定这个问题！你现在的核心困扰是Application.Match只返回匹配位置的序号，没法直接拿到对应M列的数据——咱们只要把这个序号转换成对应的M列单元格位置，就能实现你要的粘贴效果了。

先明确你的需求：在Sheet2里，用O列（第15列）的每个值匹配L列（第12列），然后把匹配行对应的M列（第13列）内容写入P列（第16列）。

现有代码问题分析 #

你当前的代码只是把Match返回的位置序号写到了P列：

Dim k As Integer
For k = 2 To 9
    ws2.Cells(k, 16).Value = Application.Match(ws2.Cells(k, 15).Value, ws2.Range("L2:L9"), 0)
Next k

Match返回的是目标值在L2:L9区域里的相对位置（比如匹配到L3的话，返回2，因为L2是区域的第1行），所以我们需要用这个位置去定位M列的对应单元格。

修正后的代码（固定行数场景） #

直接修改循环逻辑，加入位置转换和匹配失败的容错处理：

Dim k As Integer
Dim matchPos As Variant '用Variant类型，方便处理匹配不到的错误情况

For k = 2 To 9
    '先获取匹配位置
    matchPos = Application.Match(ws2.Cells(k, 15).Value, ws2.Range("L2:L9"), 0)
    
    '检查是否匹配成功
    If Not IsError(matchPos) Then
        '把相对位置转换成M列的实际行号：区域起始行(2) + 相对位置 -1
        ws2.Cells(k, 16).Value = ws2.Cells(2 + matchPos - 1, 13).Value
    Else
        '如果没匹配到，可以设置为空或者自定义提示文本
        ws2.Cells(k, 16).Value = "无匹配结果"
    End If
Next k

更灵活的动态行数版本 #

如果你的数据行数不是固定的2-9行，建议改成动态获取最后一行的版本，代码能自适应数据量变化：

Dim k As Long
Dim lastRow As Long
Dim matchPos As Variant

With ws2
    '获取L列的最后一行行号
    lastRow = .Range("L" & .Rows.Count).End(xlUp).Row
    
    For k = 2 To lastRow
        matchPos = Application.Match(.Cells(k, 15).Value, .Range("L2:L" & lastRow), 0)
        If Not IsError(matchPos) Then
            .Cells(k, 16).Value = .Cells(2 + matchPos - 1, 13).Value
        Else
            .Cells(k, 16).Value = "" '或者保留"无匹配结果"
        End If
    Next k
End With

关于你补充代码的小修正 #

你补充的跨Sheet匹配代码有几个小问题（数组维度错误、语法问题），如果是想把Sheet3的E列数据对应到Sheet2的K列，修正后的版本如下：

' 处理Sheet2的ID列(C)和目标列(K)
With ws2
    Dim lastRow As Long
    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    ' 读取C列到K列的数组，包含ID和要写入的目标列
    Dim originalData() As Variant
    originalData = .Range("C2:K" & lastRow).Value
End With

' 处理Sheet3的ID列(C)和数据源列(E)
With ws3
    Dim lastRow2 As Long
    lastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
    ' 读取C列和E列的数组，包含ID和要复制的数据
    Dim newData() As Variant
    newData = .Range("C2:E" & lastRow2).Value
End With

Dim i As Long
Dim j As Long

' 遍历Sheet3的ID，匹配Sheet2的ID并赋值
For i = LBound(newData, 1) To UBound(newData, 1)
    For j = LBound(originalData, 1) To UBound(originalData, 1)
        If newData(i, 1) = originalData(j, 1) Then
            ' 将Sheet3的E列数据写入Sheet2对应的K列位置
            originalData(j, 9) = newData(i, 3)
            Exit For '匹配到就退出内层循环，提升效率
        End If
    Next j
Next i

' 将修改后的数组写回Sheet2的K列
ws2.Range("K2:K" & lastRow).Value = Application.Index(originalData, 0, 9)

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