【Excel】【VBA】Reaction超限点筛选与散点图可视化

【Excel】【VBA】Reaction超限点筛选与散点图可视化

功能概述

这段代码实现了以下功能：

1. 从SAFE输出的结果worksheet通过datalink获取更新数据
2. 从指定工作表中读取数据
3. 检测超过阈值的数据点
4. 生成结果表格并添加格式化
5. 创建可视化散点图
6. 显示执行时间

流程图

关键方法详解

1. 性能优化技巧

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

• 禁用屏幕更新和自动计算，提高执行效率
• 完成后需要恢复这些设置

2. 数组操作

dataArray = .Range(.Cells(1, 1), .Cells(lastRow, 10)).Value
ReDim Preserve results(1 To 10, 1 To itemCount)

• 使用数组批量读取数据，比逐单元格读取更快
• ReDim Preserve 允许动态调整数组大小同时保留现有数据

3. 错误处理

On Error Resume Next
' 代码块
On Error GoTo 0

• 使用错误处理确保代码稳定性
• 可以优雅地处理工作表不存在等异常情况

4. 条件格式化

formatRange.FormatConditions.AddDatabar
With formatRange.FormatConditions(1)
    .BarFillType = xlDataBarFillSolid
    .BarColor.Color = RGB(255, 0, 0)
End With

• 添加数据条来可视化超限比率
• 使用RGB颜色定义来设置格式

5. 图表创建

Set chtObj = wsResult.ChartObjects.Add(...)
With chtObj.Chart
    .ChartType = xlXYScatter
    .SeriesCollection.NewSeries
    ' 设置数据源和格式
End With

• 使用ChartObjects创建图表对象
• 设置图表类型、数据源和格式化选项

6. 数据标签

With .DataLabels
    .ShowValue = False
    .Format.TextFrame2.TextRange.Font.Size = 8
    For pt = 1 To .Count
        .Item(pt).Text = Format(wsResult.Cells(pt + 1, "M").Value, "0.00%")
    Next pt
End With

• 为散点添加自定义数据标签
• 使用Format函数格式化百分比显示

学习要点

1. 数据处理效率

   • 使用数组批量处理数据
   • 禁用不必要的Excel功能提升性能

2. 代码结构

   • 使用With语句块简化代码
   • 合理组织代码逻辑，提高可读性

3. 错误处理

   • 在关键操作处添加错误处理
   • 确保程序稳定运行

4. Excel对象模型

   • 理解工作表、单元格范围的操作
   • 掌握图表对象的创建和设置

5. 可视化技巧

   • 条件格式化的应用
   • 散点图的创建和自定义

实用技巧

1. 使用常量定义关键值

Const THRESHOLD_VALUE As Double = 1739

2. 计时功能实现

startTime = Timer
executionTime = Format(Timer - startTime, "0.00")

3. 动态范围处理

lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row

V20250121

Sub FindExceedingValues()
    Dim wsSource As Worksheet, wsCoord As Worksheet, wsResult As Worksheet
    Dim lastRow As Long
    Dim i As Long, itemCount As Long
    Dim dataArray() As Variant
    Dim results() As Variant
    Dim startTime As Double
    Const THRESHOLD_VALUE As Double = 1739 '设置阈值变量，方便修改
    Dim chtObj As ChartObject
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    startTime = Timer
    
    'Set up worksheets
    Set wsSource = ThisWorkbook.Worksheets("Nodal Reactions")
    Set wsCoord = ThisWorkbook.Worksheets("Obj Geom - Point Coordinates")
    
    'Create or clear result worksheet
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("04.Over Points List")
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsResult.Name = "04.Over Points List"
    End If
    On Error GoTo 0
    
    wsResult.Cells.Clear
    
    'Get last row of source data
    With wsSource
        lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        
        'Read all data at once
        dataArray = .Range(.Cells(1, 1)