0
我正在嘗試在VBA中創建一個子例程，它將從兩個輸入中返回各種角度的所有可能的排列組合。第一個輸入是有多少層（或層），而第二個是任何單個層迭代的值。每個椎板的最大/最小角度爲90/0度。一個例子如下所示。使用遞歸查找複合層疊排列
我有5層。我想讓程序在第1層（3步）上使用45deg的步驟，在第2層（4步）上使用30deg的步驟，在第3層使用15deg的步驟（7步），在第4層使用10deg的步驟10步），以及在第5層（19步）5步的步驟。該程序將返回1）排列的總數和2）所有可能的排列。
現在我已經創建了一個子程序，創建了一個長度與包含其各層的每個步驟相同長度的一維數組。這個數組被傳遞給一個遞歸函數假設來執行實際的迭代。我已經有一個終止條件，所以當我需要它結束時，函數結束。
我需要這方面的數學方面的幫助，以及如何設置一個遞歸循環（因爲我假設這將是設置動態嵌套循環的唯一方法）。我在VBA方面非常有經驗，但在遞歸方面做得很少。預先感謝您的幫助。
在這種情況下排列的公式是n！/（a_1！a_2！... a_k！），對嗎？
這是代碼。我粗體顯示了與我的問題相關的部分。
Private Sub Finish_Click()
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "Finish_Click()"
Dim PD As Worksheet, ELP As Worksheet, OP As Worksheet
Dim LoopCount As Integer, i As Integer, SpaceLoc As Integer, StrLen As Integer, Number As Integer, CurrentPly As Integer, StepValue As Integer, PD_LR As Integer
Dim Permutations As Long, LoopSteps() As Long
Dim TitleRange As Range
Set OP = Worksheets("Laminate Optimization")
Set PD = Worksheets("Properties & Dimensions")
Set ELP = Worksheets("Properties & Dimensions")
LoopCount = PD.Range("A" & Rows.count).End(xlUp).Value/2
Permutations = Opti_Parameters.Opti_Permutations.Controls("Permutation_Value").Value
CurrentPly = 0
PD_LR = PD.Range("A" & Rows.count).End(xlUp).Row
ReDim LoopSteps(1 To LoopCount) As Long
Application.ScreenUpdating = False
For i = 1 To LoopCount
If Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).List(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).ListIndex) <> "" And Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).List(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).ListIndex) <> "Static" Then
SpaceLoc = InStr(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).List(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).ListIndex), " ")
StrLen = Len(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).List(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).ListIndex))
Number = Right(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).List(Opti_Parameters.Opti_Lamina.Controls("Control_" & i + (i - 1)).ListIndex), StrLen - SpaceLoc)
LoopSteps(i) = Number
End If
OP.Cells(1, 5 + i) = "Angle " & i
OP.Cells(1, 5 + i).ColumnWidth = 8
OP.Cells(1, 5 + i).HorizontalAlignment = xlCenter
OP.Cells(1, 5 + i).NumberFormat = "#,##0"
OP.Cells(1, 5 + i).Interior.Pattern = xlSolid
OP.Cells(1, 5 + i).Interior.PatternColorIndex = xlAutomatic
OP.Cells(1, 5 + i).Interior.ThemeColor = xlThemeColorDark1
OP.Cells(1, 5 + i).Interior.TintAndShade = -0.249977111117893
OP.Cells(1, 5 + i).Interior.PatternTintAndShade = 0
OP.Cells(1, 5 + i).Borders(xlEdgeBottom).LineStyle = xlContinuous
OP.Cells(1, 5 + i).Borders(xlEdgeBottom).ColorIndex = 0
OP.Cells(1, 5 + i).Borders(xlEdgeBottom).TintAndShade = 0
OP.Cells(1, 5 + i).Borders(xlEdgeBottom).Weight = xlThin
OP.Cells(1, 5 + i).Font.Bold = True
Next i
OP.Cells(1, LoopCount + 6) = "Torsional Stiffness"
OP.Cells(1, LoopCount + 7) = "Critical Speed"
OP.Cells(1, LoopCount + 8) = "Buckling Torque"
Set TitleRange = OP.Range(OP.Cells(1, LoopCount + 6), OP.Cells(1, LoopCount + 8))
With TitleRange
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -0.249977111117893
.Interior.PatternTintAndShade = 0
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeBottom).Weight = xlThin
.Font.Bold = True
.ColumnWidth = 20
.HorizontalAlignment = xlCenter
.NumberFormat = "#,##0.00"
End With
Application.ScreenUpdating = True
ReDim OriginalAngles(5 To PD_LR) As Integer
For x = 5 To PD_LR
OriginalAngles(x) = PD.Range("D" & x)
Next x
**Call NestedLoop(PD, ELP, Permutations, CurrentPly, LoopSteps, OriginalAngles)**
Exit Sub
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting subroutine." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Sub
遞歸函數：
Function NestedLoop(PD As Worksheet, ELP As Worksheet, Permutations As Long, CurrentPly As Integer, LoopSteps() As Long, OriginalAngles() As Integer) As Integer
On Error GoTo ERROR_HANDLING
Dim SubName As String
SubName = "NestedLoop()"
If CurrentPly > UBound(LoopSteps) Then End
Dim i As Long, j As Long, OP_LR As Long, OP_LC As Long
Dim OP As Worksheet
Dim x As Integer, PD_LR As Integer
PD_LR = PD.Range("A" & Rows.count).End(xlUp).Row
Set OP = Worksheets("Laminate Optimization")
If CurrentPly < UBound(LoopSteps) Then CurrentPly = CurrentPly + 1
**If CurrentPly = UBound(LoopSteps) Then
For x = 5 To PD_LR
PD.Range("D" & x) = OriginalAngles(x)
Next x
With Application
.Run "Define_Locations"
.Run "Effective_Laminate_Properties"
End With
End
End If**
Application.ScreenUpdating = False
**For i = 90/LoopSteps(CurrentPly) To 0 Step -1
PD.Range("D" & 3 + 2 * CurrentPly) = i * LoopSteps(CurrentPly)
PD.Range("D" & 4 + 2 * CurrentPly) = -i * LoopSteps(CurrentPly)**
With Application
.Run "Define_Locations"
.Run "Effective_Laminate_Properties"
.ScreenUpdating = True
End With
OP_LR = OP.Range("F" & Rows.count).End(xlUp).Row
OP_LC = 5
For j = 5 To PD.Range("A" & Rows.count).End(xlUp).Row Step 2
OP.Cells(OP_LR + 1, OP_LC + 1) = PD.Range("D" & j)
OP.Cells(OP_LR + 1, OP_LC + 1).HorizontalAlignment = xlCenter
OP_LC = OP_LC + 1
Next j
'OP.Cells(OP_LR + 1, UBound(LoopSteps) + 6) = ELP.Range("N3").Value
'OP.Cells(OP_LR + 1, UBound(LoopSteps) + 7) = ELP.Range("N5").Value
'OP.Cells(OP_LR + 1, UBound(LoopSteps) + 8) = ELP.Range("N6").Value
'OP.Range(OP.Cells(OP_LR + 1, UBound(LoopSteps) + 6), OP.Cells(OP_LR + 1, UBound(LoopSteps) + 8)).HorizontalAlignment = xlCenter
'OP.Range(OP.Cells(OP_LR + 1, UBound(LoopSteps) + 6), OP.Cells(OP_LR + 1, UBound(LoopSteps) + 8)).NumberFormat = "#,##0.00"
Next i
**Call NestedLoop(PD, ELP, Permutations, CurrentPly, LoopSteps, OriginalAngles)**
Exit Function
ERROR_HANDLING:
MsgBox "Error encountered in " & SubName & ": exiting function." _
& vbNewLine _
& vbNewLine & "Error description: " & Err.Description _
& vbNewLine & "Error number: " & Err.Number, vbCritical, Title:="Error!"
End
End Function
在沒有看到實際代碼的情況下沒有太多的事情要做...... –
我已經更新了我原來的帖子。 – senuba91
這將有助於解釋您想要在Excel中顯示的輸出。你已經列出了迭代次數，但沒有列出輸出。此外，您可能遇到的一個問題是您已將此功能標記爲功能，但不會返回任何內容。這實際上是一個子程序，而不是一個函數（或者你需要它返回一些東西）。你試圖使用遞歸的方式基本上只是另一個循環，所以看起來你最好在整個過程中創建一個外部循環，而不是使用遞歸。 – OpiesDad