根据缩进级别展开分层列表的部分

Question

我当前的电子表格设置了 2 列 - 描述和编号。"描述"列设置为分层列表，其中变量 2 是变量 1 的子部分，变量 3 是变量 2 的子部分。

例如：变量 1 表示大陆，变量 2 表示国家/地区，变量 3 表示城市。

注意：缩进仅用于视觉目的，并不表示列中的更改。

Description          Number
Variable 1A          Result
Variable 2A       Result
Variable 3A     Result
Variable 3B     Result
Variable 2B       Result
Variable 3A     Result
Variable 3B     Result
Variable 1B          Result
Variable 2A       Result
Variable 3A     Result
Variable 3B     Result
Variable 2B       Result
Variable 3A     Result
Variable 3B     Result

但是，我希望将我的数据拆分为 3 个描述变量，并在 4 列中如下所示：

Description1     Description2    Description3    Number
Variable 1A                                      Result
Variable 1A      Variable 2A                     Result
Variable 1A      Variable 2A     Variable 3A     Result
Variable 1A      Variable 2A     Variable 3B     Result
Variable 1A      Variable 2B                     Result
Variable 1A      Variable 2B     Variable 3A     Result
Variable 1A      Variable 2B     Variable 3B     Result
Variable 1B                                      Result
Variable 1B      Variable 2A                     Result
Variable 1B      Variable 2A     Variable 3A     Result
Variable 1B      Variable 2A     Variable 3B     Result
Variable 1B      Variable 2B                     Result
Variable 1B      Variable 2B     Variable 3A     Result
Variable 1B      Variable 2B     Variable 3B     Result

有关如何构建 excel VBA 宏来执行此操作的任何帮助都将非常非常有帮助。我希望这是有道理的。谢谢

Answer 1

我知道我应该等到 OP 付出更多的努力，但这看起来是一项有趣的活动，所以我还是做了。

它假设一个部分成为前一节的子节或基于2IndentLevel差异的下一节的超级节，如下所示：

Variable 1A              IndentLevel = 2
Variable 2A           IndentLevel = 4
Variable 3A        IndentLevel = 6
Variable 2B           IndentLevel = 4
Variable 1B              IndentLevel = 2

---

Option Explicit
Sub IndentOffset()
Dim lastRow As Long
lastRow = Range("A" & rows.count).End(xlUp).row
Dim numbers As Range
Set numbers = Range("B1:B" & lastRow)
'push over the "Number" column
numbers.Cut Destination:=numbers.offset(, 2)
Dim indents(2) As String
Dim cell As Range
For Each cell In Range("A2:A" & lastRow).Cells
'copy sections over based on IndentLevel
'assumes IndentLevel difference of 2 between sections
Select Case cell.IndentLevel / 2
Case 0
indents(0) = cell.Value2
Case 1
indents(1) = cell.Value2
cell.Value2 = indents(0)
cell.offset(, 1).Value2 = indents(1)
Case 2
indents(2) = cell.Value2
cell.Value2 = indents(0)
cell.offset(, 1).Value2 = indents(1)
cell.offset(, 2).Value2 = indents(2)
End Select
'reset the indent
cell.IndentLevel = 0
Next cell
End Sub