Excel使用VBA批量计算指定列的中位数和标准差并筛选指定列数据

兜兜转转,还是回到了原点,好久不写博客了。

周末调试了三四个小时,终于差不多了,不过还有一小部分问题,后面有时间再弄吧

使用方法

使用Excel 2007以上的版本,打开想要处理的XLSX表格,按Alt + F11按键打开宏编译器,粘贴想要的代码块,之后按下F5键运行即可。如果按下Alt + F11没有代码界面,可以在菜单栏打开代码窗口即可

初始Excel测试数据格式可参照如下:

代码如下:

功能1:将一组12列数据,取前10列为有效数据,第11列计算为中位数,第12列计算为标准差,并给出基本的提示信息了。

cpp 复制代码
Sub UpdateColumns()
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim lastRow As Long, lastCol As Integer
    Dim i As Long, j As Integer, groupCols As Integer
    Dim rng As Range
    Dim processedGroups As Integer  ' 新增处理组计数器
    
    groupCols = 12
    processedGroups = 0
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For j = 2 To lastCol Step groupCols
        processedGroups = processedGroups + 1  ' 计数每组处理
        
        ' 动态列边界检查(防止溢出)
        If j + 11 > Columns.Count Then Exit For
        
        ' 设置列标题
        With Cells(1, j + 10)
            .Value = "中位数"
            .HorizontalAlignment = xlCenter
        End With
        With Cells(1, j + 11)
            .Value = "标准差"
            .HorizontalAlignment = xlCenter
        End With
        
        For i = 2 To lastRow
            ' 动态计算可用列数
            Dim validCols As Integer
            validCols = Application.Min(9, lastCol - j)
            
            Set rng = Range(Cells(i, j), Cells(i, j + validCols))
            
            ' 计算中位数
            With Cells(i, j + 10)
                If .Value = "" Then
                    .Value = Application.Median(rng)
                End If
            End With
            
            ' 计算标准差
            With Cells(i, j + 11)
                If .Value = "" Then
                    If Application.Count(rng) > 1 Then
                        .Value = Application.StDev_S(rng)
                        .NumberFormat = "0.00"
                    Else
                        .Value = "N/A"
                    End If
                End If
            End With
        Next i
    Next j
    
    Columns.AutoFit
    
    ' 成功提示(新增部分)
    MsgBox "数据更新完成!" & vbCrLf & _
           "成功处理 " & processedGroups & " 个数据组" & vbCrLf & _
           "最后行号:" & lastRow & "  总列数:" & lastCol, _
           vbInformation + vbOKOnly, _
           "操作报告"
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub

ErrorHandler:
    MsgBox "操作在以下位置中断:" & vbCrLf & _
           "数据组:" & processedGroups + 1 & "  当前行:" & i & vbCrLf & _
           "错误描述:" & Err.Description, _
           vbCritical, _
           "错误报告"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

功能2 :按列筛选出想要展示的Excel数据。
用法:修改这一行代码的赋值为想要展示的列名即可:
Const HEADERS_TO_KEEP As String = "Item,Value1,Value3"

vbnet 复制代码
Option Explicit


'============= 主过程 =============
Sub FilterColumnsWithMedianAndStdDev()
    ' 配置区域(用户只需修改此处)------------------
    Const TARGET_SHEET As String = "Sheet1"           ' 目标工作表名
    Const HEADERS_TO_KEEP As String = "Item,Value1,Value3"   ' 要保留的列标题(逗号分隔)
    ' ----------------------------------------------
    
    Dim ws As Worksheet
    Dim headerNames() As String
    Dim colDict As Object
    Dim cell As Range
    Dim currentCol As Long, lastCol As Long
    Dim colName As Variant, normalizedName As String
    Dim groupStartCol As Long, groupEndCol As Long
    Dim groupIndex As Long
    
    On Error GoTo ErrorHandler
    Set colDict = CreateObject("Scripting.Dictionary")
    
    ' 1. 获取目标工作表
    Set ws = ThisWorkbook.Sheets(TARGET_SHEET)
    
    ' 2. 解析用户输入的列名并转为数组
    headerNames = Split(HEADERS_TO_KEEP, ",")
    If UBound(headerNames) < 0 Then
        MsgBox "未指定要保留的列名!", vbExclamation
        Exit Sub
    End If
    
    ' 3. 遍历标题行,构建列名字典(Key=标准化列名,Value=列号)
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    For Each cell In ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol))
        normalizedName = Trim(UCase(cell.value))
        If Not colDict.Exists(normalizedName) Then
            colDict.Add normalizedName, cell.Column
        End If
    Next cell
    
    ' 4. 校验用户输入的列名是否存在
    For Each colName In headerNames
        normalizedName = Trim(UCase(colName))
        If Not colDict.Exists(normalizedName) Then
            MsgBox "错误:列名 [" & colName & "] 不存在!", vbCritical
            Exit Sub
        End If
    Next colName
    
    ' 5. 初始化组索引和开始列
    groupIndex = 0
    groupStartCol = 1
    
    ' 6. 主逻辑:遍历所有列,处理每组前10列及其对应中位数、标准差列
    For currentCol = 1 To lastCol
        normalizedName = Trim(UCase(ws.Cells(1, currentCol).value))
        
        ' 检查是否为中位数或标准差列(每组最后两列)
        If InStr(normalizedName, "中位数") > 0 Or InStr(normalizedName, "标准差") > 0 Then
            groupEndCol = currentCol - 1  ' 当前组的结束列是当前列的前一列
            
            ' 检查组内是否有需要保留的列
            If AnyColumnToKeepInGroup(ws, groupStartCol, groupEndCol, headerNames) Then
                ' 保留当前组的第11、12列(即当前列和下一列)
                ws.Columns(currentCol).Hidden = False
                ws.Columns(currentCol + 1).Hidden = False
            Else
                ' 隐藏当前组的第11、12列
                ws.Columns(currentCol).Hidden = True
                ws.Columns(currentCol + 1).Hidden = True
            End If
            
            ' 更新组索引和起始列
            groupIndex = groupIndex + 1
            currentCol = currentCol + 1  ' 跳过已经处理的标准差列
            groupStartCol = currentCol + 1  ' 下一组开始列
        Else
            ' 处理普通列:隐藏非指定列
            If Not IsInArray(normalizedName, headerNames) Then
                ws.Columns(currentCol).Hidden = True
            End If
        End If
    Next currentCol
    
    MsgBox "操作完成!已根据条件隐藏非指定列。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "运行时错误 " & Err.Number & ":" & Err.Description & vbCrLf & _
           "可能原因:" & vbCrLf & _
           "- 工作表 '" & TARGET_SHEET & "' 不存在" & vbCrLf & _
           "- 工作表为空或标题行格式异常", vbCritical
End Sub

'============= 辅助函数 =============
' 检查数组中是否包含某个值(标准化比较)
Function IsInArray(val As String, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If Trim(UCase(element)) = val Then
            IsInArray = True
            Exit Function
        End If
    Next
    IsInArray = False
End Function

' 检查组内是否有要保留的列(核心逻辑)
Function AnyColumnToKeepInGroup( _
    ByVal ws As Worksheet, _
    ByVal startCol As Long, _
    ByVal endCol As Long, _
    ByRef headerNames() As String _
) As Boolean
    Dim i As Long
    Dim normalizedName As String
    
    ' 遍历组内每列标题
    For i = startCol To endCol
        normalizedName = Trim(UCase(ws.Cells(1, i).value))
        If IsInArray(normalizedName, headerNames) Then
            AnyColumnToKeepInGroup = True
            Exit Function
        End If
    Next i
    AnyColumnToKeepInGroup = False
End Function

功能3:将Excel中隐藏的所有列展开

vbnet 复制代码
' 扩展功能:一键显示所有隐藏列
Sub UnhideAllColumns()
    On Error Resume Next
    ThisWorkbook.Sheets("Sheet1").Columns.Hidden = False
    MsgBox "已显示所有隐藏列!", vbInformation
End Sub

结尾:

1.功能2展示指定组的中位数和标准差时,第一组的中位数和标准差还会展示出来,暂时没有修好这个问题,只能先手动处理了

2.牛会哞,马会啸,牛马只会OK收到。。。。加油吧!

相关推荐
对空六课2 小时前
动态按钮ID变化时的稳定埋点标识设计
前端·数据分析
海宇数据2 小时前
零信任架构实战:基于海宇身份证OCR构建自动化证照采集网关
人工智能·架构·自动化·ocr
天远数科2 小时前
零信任架构实战:基于天远股权穿透构建自动化供应商准入合规网关
大数据·人工智能·架构·自动化
benchmark_cc2 小时前
批量行情返回后,怎样把请求失败的股票和正常数据分开?
python·数据分析·pandas·量化交易·股票数据·quantdash
海宇服务3 小时前
零信任架构实战:基于海宇身份证OCR构建自动化自助终端核验网关
运维·人工智能·架构·自动化
cc5725026533 小时前
2027 届秋招|统计与数学类专业,公共政策研究、产业研究岗求职材料搭建思路
数据分析
泡海椒5 小时前
JQuick-Excel JQuickRow 数据准备实战:JObjectConverter、JQuickRow.toRows 与 XML 导出链路
xml·windows·excel
IT毕设梦工厂5 小时前
计算机毕业设计选题推荐:基于大数据的气象站地面观测数据分析与可视化|毕业设计选题|计算机毕设|选题推荐|毕设指导|项目定制|源码|高质量项目
大数据·hadoop·信息可视化·数据挖掘·数据分析·课程设计·大数据毕设项目
海宇大数据6 小时前
零信任架构实战:基于海宇身份证OCR构建自动化跨境清关核验网关
人工智能·架构·c#·自动化
新新学长搞科研8 小时前
【IEEE出版/论文高录用率】第七届机械自动化与智能制造国际学术会议(MAIM 2026)
自动化·制造