Question

我有以下数据表（称为“ WeightsDB”，第30行下面是具有优先级值的格式表，名为“格式”： https://ethercalc.org/zeacfw3jskc3

我有一些代码，可以使用脚本字典递归地解析这些数据，并生成以下树：

[ WeightsDB[1]

但是，我希望通过在格式表中查找一些优先级来对输出进行排序：

我坚持调整代码以处理优先级；递归对我来说已经很困难。需要注意的是，“现金”实体应始终位于每个子树的底部。这意味着，如果我的实体不在格式表中，那么它的优先级就无关紧要，因为它出现在现金之前。

实现这一目标的最有效方法是什么，甚至是非递归的？

代码：

Sub weightsSheet(wbk, USESTALE, realTimeDataVersion, closeDataVersion)
' Write to "Weights" sheet
    Dim w1 As Worksheet, w2 As Worksheet
    Dim num_rows
    Dim parent As Range, parentName As String
    Dim parentRange As Range, childrenRange As Range
    Dim childCount As Long
    Dim p As Variant
    Dim f1 As Range, f2 As Range
    currRow = 8


    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    ' Real time and close dates
    wbk.Sheets("Weights").Range("D5").Value = "Real-Time (" & realTimeDataVersion & ")"
    realTimeDate = getMaxColumn("WeightsDB", "dataTime", 0)
    wbk.Sheets("Weights").Range("D6").Value = realTimeDate

    If Not IsEmpty(USESTALE) And Not USESTALE = "NULL" Then
        If USESTALE Then
            closeType = "Stale"
        End If
    Else
        closeType = "Close"
    End If

    wbk.Sheets("Weights").Range("E5").Value = closeType & " (" & closeDataVersion & ")"
    closeDate = getMaxColumn("WeightsDB", "dataTime", 1)
    wbk.Sheets("Weights").Range("E6").Value = closeDate

    wbk.Sheets("Weights").Range("K5").Value = closeType & " Exposures"
    Set w1 = wbk.Sheets("WeightsDB")
    Set w2 = wbk.Sheets("Weights")
    num_rows = w1.Cells(Rows.Count, 1).End(xlUp).row
    'If there's no parentName column, we can't continue.
    If w1.Rows(1).Find("portfolioName") Is Nothing Then Exit Sub

    'find first instance
    Set f1 = w1.Rows(1).Find("portfolioName", lookat:=xlWhole)
    If Not f1 Is Nothing Then
        'find second instance
        Set f2 = f1.Offset(0, 1).Resize(1, w1.Columns.Count - f1.Column).Find("portfolioName", lookat:=xlWhole)
        If Not f2 Is Nothing Then
            'set range based on f2
            Set parentRange = w1.Range(f2.Offset(1, 0), _
                                       w1.Cells(Rows.Count, f2.Column).End(xlUp))

        End If
    End If
    'If there's no Root level, how do we know where to start?
    If parentRange.Find("Main") Is Nothing Then Exit Sub

    For Each parent In parentRange
        If Not dict.Exists(parent.Value) Then
            childCount = Application.WorksheetFunction.CountIf(parentRange, parent.Value)
            Set childrenRange = parent.Offset(, 2).Resize(childCount, 1)
            dict.Add parent.Value, Application.Transpose(Application.Transpose(childrenRange.Value))
        End If
    Next
    ' Recursive method to traverse our dictionary, beginning at Root element.
    Call WeightsProcessItem("", "Main", dict, w2, 7)
    wbk.Sheets("Weights").Columns("A:F").AutoFit

    Application.CalculateFull 'calculate exposures
End Sub

Private Sub WeightsProcessItem(parentName As String, name As String, dict As Object, ws As Worksheet, row_num As Long, Optional indent As Long = 0)
    Dim output As String, v
    Dim w2 As Worksheet

    'Debug.Print WorksheetFunction.Rept(" ", indent) & name
    Debug.Print parentName & name

    'Formatting
    Dim i As Integer
    For i = 3 To 6
        ws.Cells(row_num, i).ClearFormats
        ws.Cells(row_num, i).Interior.Color = RGB(255, 255, 255)
        ws.Cells(row_num, i).Font.name = "Calibri"
        ws.Cells(row_num, i).Font.Size = 10
        If i <> 6 Then
            ws.Cells(row_num, i).NumberFormat = "0.0%"
            If parentName = "Main" Or parentName = "Lima" Or name = Papa" Or name = "Main" Then
                ws.Cells(row_num, i).Font.Bold = True
            End If
        End If
        If parentName = "Main" Then
            ws.Cells(row_num, i).Borders(xlEdgeBottom).LineStyle = xlContinuous
            ws.Cells(row_num, i).Borders(xlEdgeBottom).LineStyle = xlContinuous
        End If
        If i = 6 Then
            ws.Cells(row_num, i).Borders(xlEdgeLeft).LineStyle = xlDash
            ws.Cells(row_num, i).Borders(xlEdgeRight).LineStyle = xlDash
        End If
        If indent <> 0 Then
            ws.Cells(row_num, i).InsertIndent indent / 1
        End If
    Next

    ws.Cells(row_num, 3).Value = name 'Lets worry about output mapping later

    row_num = row_num + 1
    If Not dict.Exists(name) Then
        'we're at a terminal element, a child with no children.
        Exit Sub
    Else
        On Error GoTo ErrHandler:
            For Each v In dict(name)
                ' ## RECURSION ##
                Call WeightsProcessItem(name, CStr(v), dict, ws, row_num, indent + 2)
            Next
ErrHandler:
       Exit Sub
       Resume Next
    End If

End Sub

任何帮助将不胜感激！

Answer 1

由于VBA集合以及与此相关的脚本字典缺乏公共的“下一步”方法，因此我将不使用递归。集合实际上是C结构和指针组合的现代实现。

我将格式代码移到一个单独的子例程中，该子例程从For Each v In dict(name)循环中调用。这还将使您能够在任何列表的末尾添加“现金”。

Private Sub WeightsProcessItem(parentName As String, name As String, dict As Object, ws As Worksheet, row_num As Long, Optional indent As Long = 0)
    Dim output As String
    Dim v As Variant

    'Debug.Print WorksheetFunction.Rept(" ", indent) & name
    Debug.Print parentName & name

    On Error GoTo ErrHandler:
    For Each v In dict(name)
        DoFormating name, CStr(v), ws, row_num, indent + 2
        row_num = row_num + 1
    Next
    Exit Sub

ErrHandler:
    On Error GoTo 0

End Sub

Private Sub DoFormating(parentName As String, name As String, ws As Worksheet, row_num As Long, Optional indent As Long = 0)
    'Formatting
    Dim i As Integer
    For i = 3 To 6
        ws.Cells(row_num, i).ClearFormats
        ws.Cells(row_num, i).Interior.Color = RGB(255, 255, 255)
        ws.Cells(row_num, i).Font.name = "Calibri"
        ws.Cells(row_num, i).Font.Size = 10
        If i <> 6 Then
            ws.Cells(row_num, i).NumberFormat = "0.0%"

            If (parentName = "Main") Or (parentName = "Lima") _
                Or (name = "Papa") Or (name = "Main") Then
                ws.Cells(row_num, i).Font.Bold = True
            End If
        End If
        If parentName = "Main" Then
            ws.Cells(row_num, i).Borders(xlEdgeBottom).LineStyle = xlContinuous
            ws.Cells(row_num, i).Borders(xlEdgeBottom).LineStyle = xlContinuous
        End If
        If i = 6 Then
            ws.Cells(row_num, i).Borders(xlEdgeLeft).LineStyle = xlDash
            ws.Cells(row_num, i).Borders(xlEdgeRight).LineStyle = xlDash
        End If
        If indent <> 0 Then
            ws.Cells(row_num, i).InsertIndent indent / 1
        End If
    Next

    ws.Cells(row_num, 3).Value = name 'Lets worry about output mapping later
End Sub

使用VBA在递归树解析中实现优先级列表

1 个答案: