Excel VBA实现按B列阈值拆分C列数据用于绘图

功能说明 #

遍历B列识别周期标记：

• 当B列出现±27000左右的高值时，标记新周期起始（该高值对应数据归属于前一列）
• 当B列出现500值时，标记周期结束，将当前周期的C列温度数据剪切至新列
• 自动适配不同行数的文件，处理至数据行耗尽

VBA代码 #

Sub SplitTemperatureDataByCycle()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentCol As Integer
    Dim startRow As Long
    Dim endRow As Long
    Dim i As Long
    
    ' 指定操作的工作表，可修改为具体表名如"ThisWorkbook.Sheets("数据")"
    Set ws = ActiveSheet
    ' 获取B列最后一行数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    ' 初始列设为C列（第3列）
    currentCol = 3
    ' 初始数据起始行
    startRow = 1
    
    ' 逐行遍历B列
    For i = 1 To lastRow
        ' 检测周期结束标记（B列值接近500，预留小误差）
        If Abs(ws.Cells(i, "B").Value - 500) < 10 Then
            endRow = i - 1
            ' 剪切当前周期的C列数据到目标列
            ws.Range(ws.Cells(startRow, "C"), ws.Cells(endRow, "C")).Cut _
                Destination:=ws.Cells(1, currentCol)
            ' 更新下一个周期的起始行
            startRow = i + 1
            ' 切换到下一列
            currentCol = currentCol + 1
        End If
        
        ' 检测周期起始标记（B列值接近±27000）
        If Abs(ws.Cells(i, "B").Value) > 26000 Then
            ' 高值对应数据归前一列，所以更新起始行为当前行
            startRow = i
        End If
    Next i
    
    ' 处理最后一段未标记结束的剩余数据
    If startRow <= lastRow Then
        ws.Range(ws.Cells(startRow, "C"), ws.Cells(lastRow, "C")).Cut _
            Destination:=ws.Cells(1, currentCol)
    End If
    
    MsgBox "数据拆分完成！"
End Sub

使用注意事项 #

• 运行代码前，建议先备份原数据，避免误操作导致数据丢失
• 可根据实际数据调整阈值：将Abs(ws.Cells(i, "B").Value) > 26000中的26000改为更贴合的数值；将Abs(ws.Cells(i, "B").Value - 500) < 10中的10调整为合适的误差范围
• 若需指定固定工作表，修改Set ws = ActiveSheet为Set ws = ThisWorkbook.Sheets("你的表名")

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