如何用最后一个含值单元格定义VBA范围终点替代固定行号？

原代码存在的问题 #

1. 变量声明不规范：L As Long、N As Long、j、ind均未用Dim显式声明，在VBA中容易引发类型错误，建议添加Option Explicit强制变量声明。
2. 不必要的工作表选中操作：Sheets.Select完全多余，不仅降低代码效率，还可能因当前工作表切换导致逻辑错误，应直接通过工作表对象引用单元格。
3. Index函数用法错误：原代码试图用Index查找匹配值，但Index的作用是提取数组/区域指定位置的元素，而非查找匹配项。正确的查找应使用Match函数获取匹配索引。
4. 数组维度错误：ReDim out(N, 0)定义的数组第一维长度为N，但循环仅从j=2到j=N（共N-1个元素），会导致数组末尾出现空值，应调整数组维度匹配实际需要填充的元素数量。
5. 未处理匹配失败的情况：当OPL_DUMP中B列的值在OPL_DUMP_2的F列找不到匹配时，Match会返回错误值，直接赋值会导致代码崩溃。

修正后的基础版本代码 #

Option Explicit

Sub Merging_Both_Dumps_for_Product_Type()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim keyArr As Variant, valueArr As Variant
    Dim outArr() As Variant
    Dim j As Long, matchIndex As Variant
    
    ' 绑定工作表对象，避免Select操作
    Set wsSource = ThisWorkbook.Sheets("OPL_DUMP_2")
    Set wsTarget = ThisWorkbook.Sheets("OPL_DUMP")
    
    ' 获取两表的最后行号
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row
    
    ' 读取源表的键和值数组
    keyArr = wsSource.Range("F2:F" & lastRowSource).Value
    valueArr = wsSource.Range("J2:J" & lastRowSource).Value
    
    ' 初始化结果数组，行数为目标表需要填充的行数（从第2行到最后一行）
    ReDim outArr(1 To lastRowTarget - 1, 1 To 1)
    
    ' 循环查找并填充数组
    For j = 2 To lastRowTarget
        ' 使用Match查找匹配索引，未找到则返回错误
        matchIndex = Application.Match(wsTarget.Cells(j, "B").Value, keyArr, 0)
        
        If Not IsError(matchIndex) Then
            outArr(j - 1, 1) = valueArr(matchIndex, 1)
        Else
            ' 未找到匹配时的处理，这里设为空值，可根据需求修改
            outArr(j - 1, 1) = ""
        End If
    Next j
    
    ' 将结果数组一次性写入目标表，提升效率
    wsTarget.Range("AC2:AC" & lastRowTarget).Value = outArr
End Sub

进一步优化建议（大数据量场景） #

如果两份数据转储的行数较多（比如上万行），使用Match循环查找的效率会较低，建议改用字典对象存储键值对，查找速度会大幅提升：

Option Explicit

Sub Merging_Both_Dumps_with_Dictionary()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim keyArr As Variant, valueArr As Variant
    Dim outArr() As Variant
    Dim j As Long
    Dim dict As Object
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set wsSource = ThisWorkbook.Sheets("OPL_DUMP_2")
    Set wsTarget = ThisWorkbook.Sheets("OPL_DUMP")
    
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row
    
    keyArr = wsSource.Range("F2:F" & lastRowSource).Value
    valueArr = wsSource.Range("J2:J" & lastRowSource).Value
    
    ' 将键值对存入字典
    For j = 1 To UBound(keyArr)
        ' 避免重复键，这里保留最后一个匹配值，可根据需求调整
        dict(keyArr(j, 1)) = valueArr(j, 1)
    Next j
    
    ReDim outArr(1 To lastRowTarget - 1, 1 To 1)
    
    ' 循环填充结果数组
    For j = 2 To lastRowTarget
        If dict.Exists(wsTarget.Cells(j, "B").Value) Then
            outArr(j - 1, 1) = dict(wsTarget.Cells(j, "B").Value)
        Else
            outArr(j - 1, 1) = ""
        End If
    Next j
    
    wsTarget.Range("AC2:AC" & lastRowTarget).Value = outArr
End Sub

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