南京网站设计个人,琶洲网站建设,沈阳看男科哪家医院好,免费空间说说赞领取网站
主要记录一下使用入栈出栈的方式#xff0c;记录下excel的内容折叠公式#xff0c;代码的实现不重要。重要的是解决问题的思路
这个算法中创建分组的时机是#xff1a;当需要闭合一个分组时#xff0c;且该分组包含多行内容。
具体触发条件
1. 基本规则
创建分组发…主要记录一下使用入栈出栈的方式记录下excel的内容折叠公式代码的实现不重要。重要的是解决问题的思路这个算法中创建分组的时机是当需要闭合一个分组时且该分组包含多行内容。具体触发条件1.基本规则创建分组发生在Do While循环中当检测到当前层级 ≤ 栈顶层级时If currentLevel levelStack(stackPtr) Then 结束前一个分组 startRow rowStack(stackPtr) 1 分组开始行 endRow i - 1 分组结束行 关键判断只有多于一行才创建分组 If endRow startRow Then ws.Rows(startRow : endRow).Group 创建分组 End If stackPtr stackPtr - 1 出栈 End If2.何时真正创建分组举例说明情况1需要创建分组多行内容层级1, 2, 2, 1 行号3, 4, 5, 6 处理到行6层级1时 - 栈中行4(2), 行3(1) - 当前层级1栈顶层级2 → 创建行4-5的分组 - 继续当前层级1栈顶层级1 → 创建行4-5的分组情况2不创建分组单行内容层级1, 2, 1 行号3, 4, 5 处理到行5层级1时 - 栈中行4(2), 行3(1) - 当前层级1栈顶层级2 → startRow5, endRow4 → 不创建分组 - 继续当前层级1栈顶层级1 → startRow4, endRow4 → 不创建分组为什么这样设计原因1避免单行分组Excel分组通常用于折叠/展开多行内容单行分组没有实际意义 如果分组只有一行不创建分组 If endRow startRow Then ws.Rows(startRow : endRow).Group End If这里endRow startRow保证了至少有两行。原因2自然的分组闭合创建分组的时机是发现分组结束时分组开始当遇到一个层级数字时它可能是新分组的开始入栈分组结束当遇到相同或更高层级时前一个分组结束原因3嵌套分组的需要为了正确嵌套必须在发现子分组结束后才创建父分组层级1, 2, 3, 3, 2, 1 ↑ ↑ 入栈 创建分组实际例子详解示例1创建分组行号 | 层级 3 | 1 ← 入栈(3,1) 4 | 2 ← 入栈(4,2) 5 | 2 ← 当前层级2栈顶2 → 分组4-4(单行不创建) 6 | 1 ← 当前层级1栈顶2 → 分组5-5(单行不创建) 栈顶1 → 分组4-5 ✓ (多行创建)示例2不创建分组行号 | 层级 3 | 1 ← 入栈 4 | 1 ← 当前层级1栈顶1 → 分组4-3(单行不创建)特殊情况处理情况1连续相同层级层级1, 2, 2, 2, 1 行号3, 4, 5, 6, 7 处理过程 - 行5: 层级2栈顶2 → 分组4-4(单行不创建) - 行6: 层级2栈顶2 → 分组5-5(单行不创建) - 行7: 层级1栈顶2 → 分组6-6(单行不创建) 栈顶1 → 分组4-6 ✓ (多行创建)情况2跳级层级1, 3, 2, 1 行号3, 4, 5, 6 处理过程 - 行5: 层级2栈顶3 → 分组4-4(单行不创建) - 行6: 层级1栈顶2 → 分组5-5(单行不创建) 栈顶3 → 分组4-5 ✓ (多行创建) 栈顶1 → 分组4-5 ✓ (多行创建) 注意这里会创建两个重叠的分组代码的逻辑总结入栈时机每读取一行就将其入栈作为可能的分组开始创建分组时机当遇到层级 ≤ 栈顶层级时表示前一个分组结束分组范围从栈顶行号1到当前行号-1过滤条件只有范围包含多行时才创建分组可视化理解层级1 2 3 3 2 1 | | | | | | 分组 |---------| ← 创建分组(当遇到层级2时) |----| ← 创建分组(当遇到层级3时) |----| ← 不创建(单行) |-------------------| ← 创建分组(当遇到层级1时)关键点记忆创建分组 发现分组结束 分组有多行分组结束信号当前层级 ≤ 栈顶层级分组多行判断结束行 ≥ 开始行这样设计的算法能够智能地为多行内容创建分组避免为单行创建无意义的分组正确处理嵌套关系高效利用栈来跟踪分组状态Sub CreateHierarchicalFold()Dim ws As WorksheetDim lastRow As Long, i As Long, j As LongDim startRow As Long, endRow As LongDim currentLevel As Integer, prevLevel As IntegerDim maxLevel As IntegerDim colorArr(1 To 8) As LongDim rowStack() As LongDim levelStack() As IntegerDim stackPtr As Long 设置工作表 Set ws ActiveSheet lastRow ws.Cells(ws.Rows.count, H).End(xlUp).Row 检查数据是否从第3行开始 If lastRow 3 Then MsgBox 数据不足请确保数据从第3行开始且至少有一行数据, vbExclamation Exit Sub End If 定义颜色数组 colorArr(1) RGB(219, 238, 243) 层级1 - 浅蓝色 colorArr(2) RGB(235, 241, 222) 层级2 - 浅绿色 colorArr(3) RGB(255, 242, 204) 层级3 - 浅黄色 colorArr(4) RGB(248, 203, 173) 层级4 - 浅橙色 colorArr(5) RGB(245, 215, 230) 层级5 - 浅粉色 colorArr(6) RGB(226, 239, 218) 层级6 - 浅青绿 colorArr(7) RGB(255, 235, 238) 层级7 - 浅红色 colorArr(8) RGB(237, 231, 246) 层级8 - 浅紫色 清除现有的分组和格式 ws.ClearOutline ws.Range(A3:Z lastRow).Interior.ColorIndex xlNone 查找数据区域的最大列 Dim lastCol As Long lastCol ws.Cells(1, ws.Columns.count).End(xlToLeft).Column 第一步为每行设置背景颜色 For i 3 To lastRow If IsNumeric(ws.Cells(i, H).value) Then currentLevel CInt(ws.Cells(i, H).value) 确保层级在合理范围内 If currentLevel 1 Then currentLevel 1 If currentLevel 8 Then currentLevel ((currentLevel - 1) Mod 8) 1 设置背景颜色 ws.Range(ws.Cells(i, A), ws.Cells(i, lastCol)).Interior.Color colorArr(currentLevel) End If Next i 初始化栈 ReDim rowStack(1 To lastRow) ReDim levelStack(1 To lastRow) stackPtr 0 第二步使用栈算法创建正确的嵌套分组 For i 3 To lastRow 获取当前行的层级 If IsNumeric(ws.Cells(i, H).value) Then currentLevel CInt(ws.Cells(i, H).value) Else currentLevel 1 End If 如果当前层级小于等于栈顶层级结束前一个分组 Do While stackPtr 0 If currentLevel levelStack(stackPtr) Then 结束前一个分组 startRow rowStack(stackPtr) 1 endRow i - 1 如果分组有内容多行则创建分组 If endRow startRow Then ws.Rows(startRow : endRow).Group End If stackPtr stackPtr - 1 Else Exit Do End If Loop 将当前行压入栈 stackPtr stackPtr 1 rowStack(stackPtr) i levelStack(stackPtr) currentLevel Next i 处理栈中剩余的分组 Do While stackPtr 0 startRow rowStack(stackPtr) 1 endRow lastRow If endRow startRow Then ws.Rows(startRow : endRow).Group End If stackPtr stackPtr - 1 Loop 第三步折叠所有分组显示最高层级 ws.Outline.ShowLevels RowLevels:1 自动调整列宽 ws.Columns.AutoFit MsgBox 层级折叠已创建完成 vbCrLf _ 已处理 lastRow - 2 行数据。 vbCrLf _ 点击左侧的加减号可以展开/折叠不同层级。, vbInformationEnd Sub