确定父子

Question

大家好。

我在 Excel 中创建了 VBA 宏，以在 B 列中提供缩进值（来自“设置单元格格式”屏幕的“对齐”选项卡），并尝试在 C 列中建立父/子项。输出应与 D 列匹配，但遇到困难理解逻辑。它必须查看 B 列来构建父/子，因为 A 列有时可能是不同的值。

任何帮助将不胜感激！

Sub GetIndentLevels()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim rng As Range
Dim indentLevel As Integer

' Set the worksheet
Set ws = ThisWorkbook.Sheets("Target") ' Change "Sheet1" to your sheet name

' Find the last row with data in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Loop through each row in column A
For i = 1 To lastRow
    ' Get the range for the current cell in column A
    Set rng = ws.Cells(i, "A")
    
    ' Get the indent level of the cell
    indentLevel = rng.indentLevel
    
    ' Write the indent level to column B
    ws.Cells(i, "B").Value = indentLevel
Next i
End Sub

Sub DetermineParentChild()
Dim ws As Worksheet
Dim lastRow As Long
Dim currentRow As Long
Dim currentValue As Variant
Dim nextValue As Variant
Dim markParent As Boolean

' Set the worksheet
Set ws = ThisWorkbook.Sheets("Target")

' Find the last row in column A
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' Initialize the markParent variable
markParent = False

' Loop through each row in column A
For currentRow = 1 To lastRow
    ' Get the value of column B for the current row
    currentValue = ws.Cells(currentRow, 2).Value
    
    ' Check if the current value is numeric
    If IsNumeric(currentValue) Then
        ' Check if the next row exists and get its value
        If currentRow < lastRow Then
            ' Get the value of column B for the next row
            nextValue = ws.Cells(currentRow + 1, 2).Value
        Else
            ' If there is no next row, set nextValue to a default value
            nextValue = ""
        End If
        
        ' Check if the current value should be marked as "P" (Parent) or "C" (Child)
        If markParent Then
            ws.Cells(currentRow, 3).Value = "P"
        Else
            If nextValue = currentValue + 1 Then
                ws.Cells(currentRow, 3).Value = "P"
            Else
                ws.Cells(currentRow, 3).Value = "C"
            End If
        End If
        
        ' Update the markParent variable for the next iteration
        markParent = (nextValue <> currentValue + 1)
    Else
        ' If the current value is not numeric, mark it as "C" (Child)
        ws.Cells(currentRow, 3).Value = "C"
    End If
Next currentRow
End Sub

Answer 1

亲子 vs

Range.IndentLevel

调用流程（示例）

Sub RunParentChild()

    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Target")
    Dim rg As Range:
    Set rg = ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp))
        
    With rg.EntireRow
        .Columns("B").Value = GetIndentLevels(rg) ' not necessary
        .Columns("C").Value = GetIndentedParentChildFromColumn(rg, "SUB")
    End With

End Sub

被叫（助手）程序

Function GetIndentLevels(rg As Range) As Long()
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim Data() As Long: ReDim Data(1 To rCount, 1 To cCount)
    
    Dim r As Long, c As Long
    
    For r = 1 To rCount
        For c = 1 To cCount
            Data(r, c) = rg.Cells(r, c).IndentLevel
        Next c
    Next r
    
    GetIndentLevels = Data

End Function

Function GetIndentedParentChildFromColumn( _
    rg As Range, _
    ChildBeginsWith As String, _
    Optional ColumnIndex As Long = 1) _
As Variant
    
    Dim IndentLevels() As Long: IndentLevels = GetIndentLevels(rg)
    Dim cData As Variant: cData = GetRange(rg.Columns(ColumnIndex))
    Dim rCount As Long: rCount = UBound(cData, 1)
    
    Dim r As Long, i As Long, IsFirstFound As Boolean
    
    For r = 1 To rCount
        If IsFirstFound Then
            i = IndentLevels(r, 1)
            Select Case IndentLevels(r - 1, 1)
                Case Is < i
                    If r <> rCount Then
                        If IndentLevels(r + 1, 1) > i Then
                            cData(r, 1) = "P"
                        Else
                            cData(r, 1) = "C"
                        End If
                    Else
                        cData(r, 1) = "C"
                    End If
                Case i
                    If r = rCount Then
                        If InStr(1, CStr(cData(r, 1)), ChildBeginsWith, _
                                vbTextCompare) = 1 Then
                            cData(r, 1) = "C"
                        Else
                            cData(r, 1) = "P"
                        End If
                    Else
                        If IndentLevels(r + 1, 1) > i Then
                            cData(r, 1) = "P"
                        Else
                            cData(r, 1) = "C"
                        End If
                    End If
                Case Is > i
                    If InStr(1, CStr(cData(r, 1)), ChildBeginsWith, _
                            vbTextCompare) = 1 Then
                        cData(r, 1) = "C"
                    Else
                        cData(r, 1) = "P"
                    End If
            End Select
        Else
            cData(r, 1) = "P"
            IsFirstFound = True
        End If
    Next r

    GetIndentedParentChildFromColumn = cData
    
End Function

Function GetRange(rg As Range) As Variant()
    If rg.Rows.Count + rg.Columns.Count = 2 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value: GetRange = Data
    Else
        GetRange = rg.Value
    End If
End Function