Question

我正在尝试在VBA中创建一个子程序，它将返回来自两个输入的各种角度的所有可能的排列。第一个输入是有多少个薄层（或层），而第二个是任何单个薄层迭代的值。每个薄层的最大/最小角度为90/0度。示例如下所示。

我有5个椎板。我希望程序在薄片1（3个步骤）上使用45度的步骤，在薄片2（4个步骤）上进行30度的步骤，在薄片3上进行15度的步骤（7个步骤），在薄片4上进行10度的步骤（ 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

Answer 1

这会做出与你试图用递归相同的事情，而不是使用循环，虽然我无法真实地想象你想要做什么。

Sub NestedLoop(PD As Worksheet, ELP As Worksheet, Permutations As Long, CurrentPly As Integer, LoopSteps() As Long, OriginalAngles() As Integer) 

    On Error GoTo ERROR_HANDLING
    Dim SubName As String
    SubName = "NestedLoop()"
    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
    Set OP = Worksheets("Laminate Optimization")

    Do While CurrentPly < UBound(LoopSteps)
         PD_LR = PD.Range("A" & Rows.count).End(xlUp).Row

         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

        CurrentPly = CurrentPly + 1

     Loop
     'Upon Exiting loop, CurrentPly = UBound(LoopSteps)
     PD_LR = PD.Range("A" & Rows.count).End(xlUp).Row
     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

    Exit Sub
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 Sub

用递推法找出复合材料层合板的排列

1 个答案: