VBA代码优化请求：提取Start到Finish间数据并输出至单列

问题说明 #

需求为从包含值“Start”的单元格所在行，到包含值“Finish”的单元格所在行之间，提取指定行的数据。现有代码存在两个核心问题：

• 提取结果分散在多列，无法输出到同一列
• 检查范围受限于固定声明的单元格区域，灵活性不足

优化后代码 #

Sub SubDataExtraction()
    ' 声明变量
    Dim resultRow As Long
    Dim resultArr() As Variant
    Dim startRow As Long, finishRow As Long
    Dim ws As Worksheet
    Dim cell As Range
    Dim targetCol As Range
    
    ' 初始化设置
    Set ws = ActiveSheet ' 可改为指定工作表，如ThisWorkbook.Worksheets("Sheet1")
    Set targetCol = ws.Range("L10") ' 输出起始位置
    startRow = 0
    finishRow = 0
    resultRow = 0
    
    ' 1. 定位Start和Finish的行位置
    For Each cell In ws.Range("A:A", "B:B") ' 遍历A、B列查找标记
        If cell.Value2 Like "*Start*" Then
            startRow = cell.Row
        ElseIf cell.Value2 Like "*Finish*" Then
            finishRow = cell.Row
            Exit For ' 找到Finish后停止遍历
        End If
        If cell.Row > ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Then Exit For ' 到数据末尾停止
    Next cell
    
    ' 2. 提取指定行数据（示例为Start行偏移4、5行，可根据需求调整）
    If startRow > 0 And finishRow > startRow Then
        ' 动态定义结果数组大小
        ReDim resultArr(1 To (finishRow - startRow - 1), 1 To 1)
        For i = startRow + 4 To finishRow - 1 ' 提取Start后第4行到Finish前一行的数据
            resultRow = resultRow + 1
            resultArr(resultRow, 1) = ws.Cells(i, cell.Column).Value2 ' 取对应列的值，可改为指定列如"A"
        Next i
        
        ' 输出到目标列
        targetCol.Resize(UBound(resultArr, 1), 1).Value2 = resultArr
    End If
    
    ' 清理空白并格式化
    Application.ScreenUpdating = False
    ws.Range("L10:L" & ws.Cells(ws.Rows.Count, "L").End(xlUp).Row).Value = _
        Evaluate("IF(L10:L" & ws.Cells(ws.Rows.Count, "L").End(xlUp).Row & "="""","""",TRIM(L10:L" & ws.Cells(ws.Rows.Count, "L").End(xlUp).Row & "))")
    Application.ScreenUpdating = True
End Sub

关键改动说明 #

• 单列输出适配：将结果数组改为(行数,1)的二维数组，确保输出到同一列
• 动态范围定位：遍历A、B列自动找到Start和Finish的行位置，不受固定区域限制
• 灵活数据提取：可通过调整startRow + 4提取指定偏移行的数据，适配不同需求
• 高效数组操作：用数组存储结果再一次性输出，比逐单元格写入更快
• 精准空白处理：仅清理输出列的空白内容，避免影响其他区域

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