VBA - 树形可视化。可能是迄今为止最难的代码

Question

我已经被困在这里几个小时试图为这个问题提出一个VBA excel逻辑。将此视为树问题，其中分支/节点的数量由用户确定并在开始时输入。

对于每个节点，有3种可能的结果，保持平稳，增加1％或减少1％。即对于5个节点，您将获得5 ^ 3个节点，依此类推......

如何在vba中对此进行编码，以便自动填充电子表格？

我试图模拟每年之后T + 0到T + n的城市的人口出生率，其中n是节点数。所以每1年一次，可能有101％的人口，100％或99％的人口留在城市。

为了增加复杂性，城市中的人数必须随时都是动态的。因此，例如，我们知道第5年的路径，我们每年获得+ 1％的人口。所以在第5年我们应该有（1.01）^ 5人。然而，由于这个城市充满活力，可能有人离开或进入城市，因此需要对城市人口进行人工调整。

E.G。第5年，5000人离开这个城市到另一个地方。因此，电子表格必须足够动态，以便将第5级节点从（1.01）^ 5调整到（1.01）^ 5 - 5000.并且第6个节点从那里继续......再次分支出来。

不确定我是否清楚地解释了这一点。但这似乎很难用我的业余vba技能编码。这可能吗？

此外，当我模拟10级以上

时，电子表格似乎崩溃了

Sub test()
Dim startvalue As Double, levels As Integer, j As Long, i As Long, k As Long
Application.ScreenUpdating = False
startvalue = Sheets("Sheet1").Range("A2")
levels = Sheets("Sheet1").Range("B2")
Sheets("Sheet2").Activate
Cells.ClearContents
Range("A1") = startvalue
For j = 2 To levels
  For k = Cells(Rows.Count, j - 1).End(xlUp).Row To 1 Step -1
    If Cells(k, j - 1) <> "" Then
      Rows(k + 1).Insert shift:=xlDown
      Cells(k + 1, j) = Cells(k, j - 1).Value * 0.99
      Cells(k, j) = Cells(k, j - 1).Value
      Rows(k).Insert shift:=xlDown
      Cells(k, j) = Cells(k + 1, j - 1).Value * 1.1
    End If
  Next k
Next j
End Sub

Answer 1

首先，我建议您将结果存储在内存中，然后在完成后将其显示在电子表格中。在循环中插入行是主要的性能杀手。

对于数据结构，您可以使用存储每年结果的二维数组

e.g。

第1年：数组（1,1）到数组（1,3）

第2年：数组（2,1）到数组（2,9）

第3年：数组（3,1）到数组（3,27） ...

一旦评估了这个结构，就可以使用第二个循环在电子表格上“明白地”显示它，而不用在任何地方插入这些行的痛苦

就像那样

Dim values() As Long

Sub main()

Dim startvalue As Double, levels As Integer
Dim i, j, k As Long

startvalue = 2000
levels = 3

ReDim values(levels, 3 ^ levels)

' == Calculate pop evolution for every year ==
values(1, 1) = startvalue

For i = 2 To levels

    k = 1

    For j = 1 To 3 ^ (levels - 2)
        values(i, k) = values(i - 1, j)
        values(i, k + 1) = values(i - 1, j) * 0.99
        values(i, k + 2) = values(i - 1, j) * 1.01
        k = k + 3
    Next j

Next i

' == Display in on spreadsheet ==
Sheets("Sheet2").Activate

For i = 1 To levels
    Cells(4, i) = i

    k = 1

    For j = 1 To 3 ^ (i - 1)
        Cells(4 + k, i) = values(i, k)
        k = k + 1
    Next j
Next i

End Sub