如何在VBA二维数组中查找值最后出现位置并偏移索引找目标值？

我方软件生成的Excel文件包含28000行64列，无格式规范，存在空单元格、标题、嵌套表格等混乱内容。需求是找到某一值最后出现位置之后的第一个目标值，并将其导入至另一Excel文件。

原本使用Range.Find()方法可实现需求，但200多次查找导致宏运行速度极慢，因此计划将工作表数据存入二维数组进行操作，但不清楚如何通过循环实现「查找值的最后出现位置」并偏移索引找到目标值。附上原实现代码：

Function GetMiles(TruckList() As String, FilePath As String)
    Dim OOWorkbook As Workbook 'This main workbook
    Dim DSWorkbook As Workbook 'Driver settlement workbook
    Dim TruckNumber As String 'To Save truck number
    Dim truck As Variant 'To loop through array
    Dim YOS As String 'Value of revenue
    Dim IntA As Integer 'For counting
    Dim TruckRange As Range 'The range to search for the truck number
    Dim TruckWhere As Range 'To store the cell number of the truck and access range properties
    Dim YOSWhere As Range 'To store the cell of Years of Service and access range properties
    Dim LastTruckCell As String 'Cell of the last occurrence of the truck
    Dim YOSCell As String 'Cell of the first occurence of the Year of Service
    Dim YOSCellRange As Range 'The range to search for the value of YOS based on the location of Years of Service
    Dim YOSRange As Range 'The range to search for Years of Service
    Dim UTruckList As Integer 'Check array size
    Dim GrossEarningsRange As Range 'The range to search for Gross Earnings
    Dim GrossWhere As Range 'To store cell of Gross Earnings and access range properties
    Dim GrossCell As String 'To store cell position of Gross Earnings
    Dim GrossOrYOS As String 'To check if the above row is Years of Service or something else
    Dim LCV As String 'To check if the truck is LCV or not
    
    'Set the OO workbook
    Set OOWorkbook = ThisWorkbook
    
    'Open Driver Settlement workbook
    Set DSWorkbook = Workbooks.Open(FilePath)
    
    'TruckArray = TruckList()
    UTruckList = UBound(TruckList)
    
    IntA = 0
    
    'Loop through tuck array
    For Each truck In TruckList
        If IntA > UTruckList Then 'Make sure IntA is within array index to handle subscript out of range error
            Exit For
        Else
            TruckNumber = TruckList(IntA) 'Access array value
            If TruckNumber = "" Then
                'Do nothing
            Else
                Set TruckRange = DSWorkbook.Worksheets(1).UsedRange 'Set the range to look for the truck number
                Set TruckWhere = TruckRange.Find(What:=TruckNumber, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious) 'Find the cell of the last occurrence of that truck number
                If (TruckWhere Is Nothing) Then 'Check if no truck was found
                    IntA = IntA + 1
                Else
                    LastTruckCell = TruckWhere.Address(0, 0) 'Get cell number of last occurence of truck number
                    Set GrossEarningsRange = DSWorkbook.Worksheets(1).UsedRange
                    Set GrossWhere = GrossEarningsRange.Find(What:="Total Gross Earnings on Trips", After:=Range(LastTruckCell), SearchOrder:=xlByRows, SearchDirection:=xlNext)
                    GrossCell = GrossWhere.Address(0, 0) 'Get cell position of Gross Earnings on Trips
                    Set YOSCellRange = DSWorkbook.Worksheets(1).Range(GrossCell) 'Set the range to search for the YOS value based on the cell number of Years of Service
                    GrossOrYOS = YOSCellRange.Offset(-1, 0)
                    If GrossOrYOS = "YEARS OF SERVICE" Then
                        YOS = YOSCellRange.Offset(-1, 17) 'Get the value of the YOS
                        LCV = OOWorkbook.Worksheets(TruckNumber).Range("D4").Value
                        If LCV = "LCV" Then
                            OOWorkbook.Worksheets(TruckNumber).Range("F12").Value = YOS 'to assign YOS to LCV cell
                        Else
                            OOWorkbook.Worksheets(TruckNumber).Range("E12").Value = YOS 'Update truck sheet with YOS value
                        End If
                    Else
                        'Do nothing/skip
                    End If
                    IntA = IntA + 1
                    Call GetCityWork(FilePath, GrossCell, LastTruckCell, TruckNumber)
                End If
            End If
        End If
    Next truck
End Function

使用二维数组替代Range操作能大幅提升运行速度，核心思路是：

1. 一次性将整个工作表数据读入二维数组，减少Excel对象模型的交互次数
2. 先遍历数组一次，记录所有卡车编号的最后出现行号
3. 针对每个卡车编号，从其最后出现行号开始向后查找目标值
4. 找到目标值后，按逻辑更新目标工作表数据

修改后的代码如下：

Function GetMiles(TruckList() As String, FilePath As String)
    Dim OOWorkbook As Workbook
    Dim DSWorkbook As Workbook
    Dim TruckNumber As String
    Dim IntA As Integer
    Dim UTruckList As Integer
    Dim wsData As Worksheet
    Dim dataArr As Variant '存储工作表的二维数组
    Dim lastTruckRow As Long '记录卡车编号最后出现的行号
    Dim i As Long, j As Long
    Dim foundGross As Boolean
    Dim grossRow As Long
    Dim YOS As String
    Dim LCV As String
    
    '初始化工作簿
    Set OOWorkbook = ThisWorkbook
    Set DSWorkbook = Workbooks.Open(FilePath)
    Set wsData = DSWorkbook.Worksheets(1)
    
    '将工作表数据一次性读入二维数组
    dataArr = wsData.UsedRange.Value
    UTruckList = UBound(TruckList)
    
    '遍历卡车列表
    For IntA = 0 To UTruckList
        TruckNumber = TruckList(IntA)
        If TruckNumber = "" Then GoTo NextTruck
        
        '第一步：查找当前卡车编号的最后出现行号
        lastTruckRow = 0
        For i = LBound(dataArr, 1) To UBound(dataArr, 1)
            For j = LBound(dataArr, 2) To UBound(dataArr, 2)
                If dataArr(i, j) = TruckNumber Then
                    lastTruckRow = i '更新为当前行，最终得到最后出现的行
                End If
            Next j
        Next i
        
        '如果没找到卡车编号，跳过
        If lastTruckRow = 0 Then GoTo NextTruck
        
        '第二步：从最后出现行号往后找"Total Gross Earnings on Trips"
        foundGross = False
        grossRow = 0
        For i = lastTruckRow To UBound(dataArr, 1)
            For j = LBound(dataArr, 2) To UBound(dataArr, 2)
                If dataArr(i, j) = "Total Gross Earnings on Trips" Then
                    grossRow = i
                    foundGross = True
                    Exit For '找到第一个目标值后退出列循环
                End If
            Next j
            If foundGross Then Exit For '退出行循环
        Next i
        
        '如果没找到目标值，跳过
        If Not foundGross Then GoTo NextTruck
        
        '第三步：检查上一行是否为"YEARS OF SERVICE"并获取对应值
        If grossRow > 1 Then '确保上一行存在
            If dataArr(grossRow - 1, 1) = "YEARS OF SERVICE" Then '列索引可根据实际数据调整
                YOS = dataArr(grossRow - 1, 18) '原Offset(-1,17)对应数组列索引+1（数组从1开始）
                '更新目标工作表数据
                LCV = OOWorkbook.Worksheets(TruckNumber).Range("D4").Value
                If LCV = "LCV" Then
                    OOWorkbook.Worksheets(TruckNumber).Range("F12").Value = YOS
                Else
                    OOWorkbook.Worksheets(TruckNumber).Range("E12").Value = YOS
                End If
                '调用其他函数
                Call GetCityWork(FilePath, wsData.Cells(grossRow, j).Address(0, 0), wsData.Cells(lastTruckRow, j).Address(0, 0), TruckNumber)
            End If
        End If
        
NextTruck:
    Next IntA
    
    '关闭数据源工作簿（可根据需求决定是否保存）
    DSWorkbook.Close SaveChanges:=False
End Function

关键优化点说明 #

• 数组一次性读取：dataArr = wsData.UsedRange.Value将整表数据读入内存，避免多次访问Excel对象模型，这是速度提升的核心
• 预存最后出现行号：遍历一次数组记录所有卡车的最后位置，避免重复查找
• 定向查找：找到卡车最后位置后，仅从该位置向后查找目标值，减少遍历范围
• 减少Range操作：仅在需要传递地址给其他函数时，通过数组索引转换为单元格地址

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