Excel VBA批量从错误文本中提取两个数值的实现求助

核心优化逻辑 #

• 关闭Excel非必要功能（屏幕更新、自动计算、事件触发），消除运行时的额外开销
• 放弃逐单元格操作、Select/ActiveCell调用、写入单元格公式的低效写法，改用内存数组+VBA原生字符串函数直接处理数据，5000条数据可在1秒内完成处理
• 避免频繁的单元格I/O交互，一次性读取全量原始数据、处理完成后一次性回写结果

完整实现代码 #

Sub ExtractLeaveErrorValues()
    Dim lastRow As Long, i As Long
    Dim rawArr As Variant, resArr As Variant
    Dim myString As String
    Dim posHours As Long, posExceed As Long
    Dim val1 As Double, val2 As Double
    
    ' 开启性能优化
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 原始错误文本默认存放在J列、从第2行开始，可修改列号/起始行适配你的表格
    lastRow = Cells(Rows.Count, "J").End(xlUp).Row
    rawArr = Range("J2:J" & lastRow).Value ' 一次性读取所有原始文本到内存数组
    ReDim resArr(1 To UBound(rawArr), 1 To 4) ' 结果数组对应：F列分类、G列差值、H列数值1、I列数值2
    
    ' 循环处理每一条数据
    For i = 1 To UBound(rawArr)
        myString = CStr(rawArr(i, 1))
        ' 判断是否是目标类型错误
        If InStr(myString, "Additional Leave hours ") > 0 And InStr(myString, "exceed entitlement plus pro-rata") > 0 Then
            ' 提取第一个数值：hours后到exceed前的内容
            posHours = InStr(myString, "hours ") + 6 ' hours加空格共6个字符
            posExceed = InStr(myString, " exceed")
            val1 = CDbl(Trim(Mid(myString, posHours, posExceed - posHours)))
            
            ' 提取第二个数值：字符串最后一段空格分隔的内容
            val2 = CDbl(Trim(Split(myString, " ")(UBound(Split(myString, " ")))))
            
            ' 写入结果数组
            resArr(i, 1) = "Additional Leave hours exceed entitlement plus pro-rata" ' F列分类
            resArr(i, 3) = val1 ' H列第一个数值
            resArr(i, 4) = val2 ' I列第二个数值
            resArr(i, 2) = val1 - val2 ' G列差值，直接计算无需调用SUM公式
        End If
    Next i
    
    ' 一次性把结果回写至工作表，对应F2:I列范围
    Range("F2:I" & lastRow).Value = resArr
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

使用说明 #

如果需要适配你的表格结构，修改对应列号、起始行即可；如果需要处理其他类型的错误分类，复制If分支逻辑，修改匹配规则和提取逻辑即可。

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