开发进度表格式自动设置工具作者信息作者LXIAO版本3.0更新2026年3月实现功能1. 智能分组管理彻底清除所有分组自动清除工作表中所有层级的分组支持1-8级空行智能分组空行根据其下方第一个非空行的级别自动设置相同级别连续空行同组多个连续空行都属于同一分组级别2. 大纲级别自动重建根据A列内容和空行位置自动计算并设置正确的大纲级别A列内容点号数量基础级别示例整数如201级2 → 1级1个点号如2.112级2.1 → 2级2个点号如2.1.123级2.1.1 → 3级3. 空行分组规则规则1同级分组空行与下方内容同级A列数据 | 大纲级别 2 | 1级 2.1 | 2级 2.2 | 2级 (空行) | 2级 2.3 | 2级规则2下级分组连续空行标记下级开始A列数据 | 大纲级别 2 | 1级 2.1 | 2级 2.2 | 2级 (空行) | 3级 (空行) | 3级 2.3.1 | 3级4. 智能字体格式统一字体A到AC列全部设置为微软雅黑智能加粗A列为整数如1、“2”A到E列字体加粗A列为小数或空A到E列字体不加粗5. 智能缩进设置整数行A到E列缩进全部为0小数行A列和E列根据点号数量缩进1个点号缩进1级2个点号缩进2级…B、C、D列缩进保持为0空行A到E列缩进全部为06. 高性能优化数组批量处理一次性读取数据到内存减少单元格访问批量格式设置使用Range对象批量设置格式性能优化开关关闭屏幕更新、事件触发、自动计算等执行时间统计在立即窗口显示处理耗时完整代码1. ThisWorkbook 代码 ThisWorkbook 代码模块 作者LXIAO 更新2026年3月 功能保存工作簿时自动格式化开发进度表 PrivateSubWorkbook_BeforeSave(ByValSaveAsUIAsBoolean,CancelAsBoolean) 保存前自动执行格式化CallFormatDevProgressSheetEndSub2. 模块代码 开发进度表保存时彻底清空所有分组无论多少层 然后根据 A 列和空行重建正确的 OutlineLevel 优化版本支持1000行快速执行 作者LXIAO 更新2026年3月 SubFormatDevProgressSheet()DimwsAsWorksheetSetwsGetTargetWorksheet()IfwsIsNothingThenExitSubDimlastRowAsLonglastRowws.Cells(ws.Rows.count,A).End(xlUp).RowIflastRow1ThenExitSub 关闭所有可能影响性能的设置Application.ScreenUpdatingFalseApplication.EnableEventsFalseApplication.CalculationxlCalculationManual Application.DisplayStatusBarFalseOn ErrorGoToCleanExit 记录开始时间DimstartTimeAsDoublestartTimeTimer 彻底清除所有分组ClearAllOutlineCompletely ws 重置所有行 OutlineLevel 为 1ws.Rows(1:lastRow).OutlineLevel1 使用数组批量处理数据DimdataArrayAsVariant dataArrayws.Range(A1:AlastRow).Value 先统一设置所有字体为微软雅黑不加粗ws.Range(A1:AClastRow).Font.Name微软雅黑ws.Range(A1:AClastRow).Font.BoldFalse 准备批量设置格式DimiAsLongDimjAsLongDimlevelStrAsStringDimdotCountAsLongDimisIntegerLevelAsBooleanDimdepthAsLongDimcurrentDepthAsLongDimnextNonEmptyLevelAsLong 初始化深度数组DimdepthArray()AsLongReDimdepthArray(1TolastRow) 第一遍遍历从下往上查找每个空行下方第一个非空行的级别ForilastRowTo1Step-1levelStrTrim(CStr(dataArray(i,1)))IflevelStrThen 空行查找下方第一个非空行nextNonEmptyLevel0Forji1TolastRowIfTrim(CStr(dataArray(j,1)))Then 找到下方第一个非空行使用它的级别nextNonEmptyLeveldepthArray(j)ExitForEndIfNextjIfnextNonEmptyLevel0Then 如果找到下方非空行使用相同的级别depthArray(i)nextNonEmptyLevelElse 如果下方没有非空行即文档末尾的空行使用1级depthArray(i)1EndIfElse 非空行根据点号计算级别isIntegerLevel(InStr(1,levelStr,.)0)IfisIntegerLevelThendotCount0ElsedotCountLen(levelStr)-Len(Replace(levelStr,.,))EndIf 计算大纲级别深度depthdotCount1Ifdepth8Thendepth8depthArray(i)depthEndIfNexti 第二遍遍历设置格式和大纲级别Fori1TolastRow levelStrTrim(CStr(dataArray(i,1)))currentDepthdepthArray(i)IflevelStrThen 非空行isIntegerLevel(InStr(1,levelStr,.)0) 设置粗体只有A列为整数时A:E列才加粗IfisIntegerLevelThenws.Range(Ai:Ei).Font.BoldTrueEndIf 设置缩进IfisIntegerLevelThen 整数行A:E列缩进为0ws.Range(Ai:Ei).indentLevel0Else 非整数行根据点号数量设置缩进dotCountLen(levelStr)-Len(Replace(levelStr,.,))ws.Cells(i,A).indentLeveldotCount ws.Cells(i,E).indentLeveldotCount ws.Range(Bi:Di).indentLevel0EndIfElse 空行字体保持不加粗缩进设置为0ws.Range(Ai:Ei).indentLevel0EndIf 设置大纲级别ws.Rows(i).OutlineLevelcurrentDepthNexti 显示执行时间Debug.Print开发进度表格式化完成耗时: Format(Timer-startTime,0.00) 秒共处理 lastRow 行CleanExit: 恢复设置Application.ScreenUpdatingTrueApplication.EnableEventsTrueApplication.CalculationxlCalculationAutomatic Application.DisplayStatusBarTrueEndSub ------------------------------------------------ 彻底清除所有行分组优化版本 ------------------------------------------------PrivateSubClearAllOutlineCompletely(wsAsWorksheet)On ErrorResumeNextDimiAsInteger 一次性清除所有分组Fori1To8ws.Rows.UngroupNextiOn ErrorGoTo0EndSub ------------------------------------------------ 获取目标工作表 ------------------------------------------------PrivateFunctionGetTargetWorksheet()AsWorksheetOn ErrorResumeNextSetGetTargetWorksheetThisWorkbook.Worksheets(开发进度)On ErrorGoTo0IfGetTargetWorksheetIsNothingThenMsgBox未找到名为“开发进度”的工作表操作已取消。,_ vbExclamation,错误提示EndIfEndFunction 手动执行格式化 SubManualFormatDevProgress()CallFormatDevProgressSheetEndSub 仅清除分组不设置格式 SubClearAllGroupsOnly()DimwsAsWorksheetSetwsGetTargetWorksheet()IfwsIsNothingThenExitSubApplication.ScreenUpdatingFalseCallClearAllOutlineCompletely(ws)Application.ScreenUpdatingTrueMsgBox所有分组已清除,vbInformationEndSub 测试功能显示每个空行的分组级别 SubTestEmptyRowGrouping()DimwsAsWorksheetSetwsGetTargetWorksheet()IfwsIsNothingThenExitSubDimlastRowAsLonglastRowws.Cells(ws.Rows.count,A).End(xlUp).Row 创建测试数据ws.Range(A1).Value2ws.Range(A2).Value2.1ws.Range(A3).Value2.2ws.Range(A4).Valuews.Range(A5).Value2.3ws.Range(A6).Valuews.Range(A7).Valuews.Range(A8).Value2.3.1 执行格式化CallFormatDevProgressSheet MsgBox测试完成请查看A列的分组效果,vbInformationEndSub安装说明步骤1打开VBA编辑器打开Excel文件按Alt F11打开VBA编辑器步骤2添加ThisWorkbook代码在左侧工程资源管理器中双击ThisWorkbook将上面的ThisWorkbook代码复制粘贴到右侧代码窗口步骤3添加模块代码在VBA编辑器中点击菜单插入 → 模块将上面的模块代码复制粘贴到右侧代码窗口步骤4保存并启用宏按Ctrl S保存选择保存为启用宏的工作簿.xlsm使用说明自动执行每次保存工作簿时自动执行FormatDevProgressSheet手动执行按Alt F8打开宏对话框选择以下宏执行ManualFormatDevProgress手动执行格式化ClearAllGroupsOnly只清除分组有提示TestEmptyRowGrouping测试空行分组功能有提示注意事项1. 工作表名称必须确保工作表名称为“开发进度”区分大小写2. 文件格式文件必须保存为启用宏的工作簿.xlsm 格式3. 宏安全设置需要在Excel中启用宏文件 → 选项 → 信任中心 → 信任中心设置 → 宏设置 → 启用所有宏4. 列范围限制字体设置覆盖A到AC列共29列缩进设置只覆盖A到E列共5列粗体设置只影响A到E列5. 大纲级别限制Excel最多支持8级大纲超过8级的会自动限制为8级6. 空行处理规则空行级别 下方第一个非空行的级别连续空行都属于同一级别文档末尾的空行自动设为1级7. 查看执行时间按Ctrl G打开立即窗口查看执行时间和处理行数