长码需要数组
自从我处理VBA以来，我已经有一段时间了，我写了一些相当不雅的东西。
有人可以build议一种方法来缩短以下代码？ 我想arrays可以帮助，但我不知道如何实现它。
代码的目的是build立螺纹pipe道系统，它必须以相当精确的长度进行组合。 程序总是使用最大长度的pipe道，以适应所需pipe道长度的剩余量。
为了保持代码尽可能短，我省略了维度variables和显示结果的部分。
在此先感谢您的帮助。
Sub ThreadedPipeCalc() Dim desLength As Single, end1 As String, end2 As String Dim none As Single, CS_Con As Single, CS_Un As Single Dim CS_90deg As Double, CS_Tee As Single, CS_Flange As Single Dim CS_Con_ct As Integer, CS_Un_ct As Integer, CS_Flange_ct As Integer Dim CS_90deg_ct As Integer, CS_Tee_ct As Integer Dim CS_Con_ct_tot As Integer, CS_Un_ct_tot As Integer Dim CS_90deg_ct_tot As Integer, CS_Tee_ct_tot As Integer Dim A_pipe As Single, B_pipe As Single, C_pipe As Single Dim D_pipe As Single, E_pipe As Single, F_pipe As Single Dim H_pipe As Single, I_pipe As Single, J_pipe As Single Dim K_pipe As Single, L_pipe As Single, M_pipe As Single Dim N_pipe As Single, O_pipe As Single, P_pipe As Single Dim Q_pipe As Single, R_pipe As Single, S_pipe As Single Dim T_pipe As Single, U_pipe As Single, V_pipe As Single Dim W_pipe As Single, X_pipe As Single, Y_pipe As Single Dim Z_pipe As Single, Threadin As Single, FULLY_pipe As Single Dim A_ct As Integer, B_ct As Integer, C_ct As Integer Dim D_ct As Integer, E_ct As Integer, F_ct As Integer Dim H_ct As Integer, I_ct As Integer, J_ct As Integer Dim K_ct As Integer, L_ct As Integer, M_ct As Integer Dim N_ct As Integer, O_ct As Integer, P_ct As Integer Dim Q_ct As Integer, R_ct As Integer, S_ct As Integer Dim T_ct As Integer, U_ct As Integer, V_ct As Integer Dim W_ct As Integer, X_ct As Integer, Y_ct As Integer Dim Z_ct As Integer, FULLY_ct As Integer Dim A_ct_tot As Integer, B_ct_tot As Integer, C_ct_tot As Integer Dim D_ct_tot As Integer, E_ct_tot As Integer, F_ct_tot As Integer Dim H_ct_tot As Integer, I_ct_tot As Integer, J_ct_tot As Integer Dim K_ct_tot As Integer, L_ct_tot As Integer, M_ct_tot As Integer Dim N_ct_tot As Integer, O_ct_tot As Integer, P_ct_tot As Integer Dim Q_ct_tot As Integer, R_ct_tot As Integer, S_ct_tot As Integer Dim T_ct_tot As Integer, U_ct_tot As Integer, V_ct_tot As Integer Dim W_ct_tot As Integer, X_ct_tot As Integer, Y_ct_tot As Integer Dim Z_ct_tot As Integer, FULLY_ct_tot As Integer Dim segCount As Integer Dim CountRedux As Boolean, continue As Integer continue = 6 none = 0 CS_Con = 2.53 SS_Con = 2.5 CS_Un = 3 SS_Un = 2.85 CS_90deg = 2.25 SS_90deg = 2.28 CS_Tee = 2.25 SS_Tee = 2.26 CS_Flange = 1 SS_Flange = 1 SS_Flang_red = 1.1875 SS_Cap = 1.77 Threadin = 0.563 A_pipe = 126 B_pipe = 72 C_pipe = 60 D_pipe = 48 E_pipe = 36 F_pipe = 24 G_pipe = 22 H_pipe = 20 I_pipe = 18 J_pipe = 16 K_pipe = 14 L_pipe = 12 M_pipe = 11 N_pipe = 10 O_pipe = 9 P_pipe = 8 Q_pipe = 7 R_pipe = 6.5 S_pipe = 6 T_pipe = 5.5 U_pipe = 5 V_pipe = 4.5 W_pipe = 4 X_pipe = 3.5 Y_pipe = 3 Z_pipe = 2.5 FULLY_pipe = 2 While continue = 6 segCount = 0 Range("C3:C32").Value = 0 CS_Con_ct = 0 CS_Un_ct = 0 CS_90deg_ct = 0 CS_Tee_ct = 0 CS_Flange_ct = 0 A_ct = 0 B_ct = 0 C_ct = 0 D_ct = 0 E_ct = 0 F_ct = 0 G_ct = 0 H_ct = 0 I_ct = 0 J_ct = 0 K_ct = 0 L_ct = 0 M_ct = 0 N_ct = 0 O_ct = 0 P_ct = 0 Q_ct = 0 R_ct = 0 S_ct = 0 T_ct = 0 U_ct = 0 V_ct = 0 W_ct = 0 X_ct = 0 Y_ct = 0 Z_ct = 0 FULLY_ct = 0 CS_Con_ct_tot = Range("D3") CS_Un_ct_tot = Range("D4") CS_90deg_ct_tot = Range("D5") CS_Tee_ct_tot = Range("D6") A_ct_tot = Range("D7") B_ct_tot = Range("D8") C_ct_tot = Range("D9") D_ct_tot = Range("D10") E_ct_tot = Range("D11") F_ct_tot = Range("D12") G_ct_tot = Range("D13") H_ct_tot = Range("D14") I_ct_tot = Range("D15") J_ct_tot = Range("D16") K_ct_tot = Range("D17") L_ct_tot = Range("D18") M_ct_tot = Range("D19") N_ct_tot = Range("D20") O_ct_tot = Range("D21") P_ct_tot = Range("D22") Q_ct_tot = Range("D23") R_ct_tot = Range("D24") S_ct_tot = Range("D25") T_ct_tot = Range("D26") U_ct_tot = Range("D27") V_ct_tot = Range("D28") W_ct_tot = Range("D29") X_ct_tot = Range("D30") Y_ct_tot = Range("D31") Z_ct_tot = Range("D32") FULLY_ct_tot = Range("D33") desLength = Application.InputBox("Enter the desired end to center or center to center length", Type:=1) end1 = Application.InputBox("Enter End1 Connection (none, Connector, Union, 90deg, or Tee)", Type:=2) If end1 = Range("A1") Then CountRedux = True Else CountRedux = False End If end2 = Application.InputBox("Enter End2 Connection (none, Connector, Union, 90deg, or Tee)", Type:=2) Range("A1") = end2 Range("B2") = desLength If end1 = "Connector" Then CS_Con_ct = CS_Con_ct + 1 If CountRedux = False Then CS_Con_ct_tot = CS_Con_ct_tot + 1 desLength = desLength - CS_Con + Threadin End If If end1 = "Union" Then CS_Un_ct = CS_Un_ct + 1 If CountRedux = False Then CS_Un_ct_tot = CS_Un_ct_tot + 1 desLength = desLength - CS_Un + Threadin End If If end1 = "90deg" Then CS_90deg_ct = CS_90deg_ct + 1 If CountRedux = False Then CS_90deg_ct_tot = CS_90deg_ct_tot + 1 desLength = desLength - CS_90deg + Threadin End If If end1 = "Tee" Then CS_Tee_ct = CS_Tee_ct + 1 If CountRedux = False Then CS_Tee_ct_tot = CS_Tee_ct_tot + 1 desLength = desLength - CS_Tee + Threadin End If If end2 = "Connector" Then CS_Con_ct = CS_Con_ct + 1 CS_Con_ct_tot = CS_Con_ct_tot + 1 desLength = desLength - CS_Con + Threadin End If If end2 = "Union" Then CS_Un_ct = CS_Un_ct + 1 CS_Un_ct_tot = CS_Un_ct_tot + 1 desLength = desLength - CS_Un + Threadin End If If end2 = "90deg" Then CS_90deg_ct = CS_90deg_ct + 1 CS_90deg_ct_tot = CS_90deg_ct_tot + 1 desLength = desLength - CS_90deg + Threadin End If If end2 = "Tee" Then CS_Tee_ct = CS_Tee_ct + 1 CS_Tee_ct_tot = CS_Tee_ct_tot + 1 desLength = desLength - CS_Tee + Threadin End If 'While desLength >= A_pipe ' A_ct = A_ct + 1 ' segCount = segCount + 1 ' desLength = desLength - A_pipe ' If segCount > 2 Then ' desLength = desLength + CS_Con - Threadin - Threadin ' End If 'Wend While desLength >= B_pipe B_ct = B_ct + 1 segCount = segCount + 1 desLength = desLength - B_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= C_pipe C_ct = C_ct + 1 segCount = segCount + 1 desLength = desLength - C_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= D_pipe D_ct = D_ct + 1 segCount = segCount + 1 desLength = desLength - D_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= E_pipe E_ct = E_ct + 1 segCount = segCount + 1 desLength = desLength - E_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= F_pipe F_ct = F_ct + 1 segCount = segCount + 1 desLength = desLength - F_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= G_pipe G_ct = G_ct + 1 segCount = segCount + 1 desLength = desLength - G_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= H_pipe H_ct = H_ct + 1 segCount = segCount + 1 desLength = desLength - H_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= I_pipe I_ct = I_ct + 1 segCount = segCount + 1 desLength = desLength - I_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= J_pipe J_ct = J_ct + 1 segCount = segCount + 1 desLength = desLength - J_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= K_pipe K_ct = K_ct + 1 segCount = segCount + 1 desLength = desLength - K_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= L_pipe L_ct = L_ct + 1 segCount = segCount + 1 desLength = desLength - L_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= M_pipe M_ct = M_ct + 1 segCount = segCount + 1 desLength = desLength - M_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= N_pipe N_ct = N_ct + 1 segCount = segCount + 1 desLength = desLength - N_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= O_pipe O_ct = O_ct + 1 segCount = segCount + 1 desLength = desLength - O_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= P_pipe P_ct = P_ct + 1 segCount = segCount + 1 desLength = desLength - P_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= Q_pipe Q_ct = Q_ct + 1 segCount = segCount + 1 desLength = desLength - Q_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= R_pipe R_ct = R_ct + 1 segCount = segCount + 1 desLength = desLength - R_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= S_pipe S_ct = S_ct + 1 segCount = segCount + 1 desLength = desLength - S_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= T_pipe T_ct = T_ct + 1 segCount = segCount + 1 desLength = desLength - T_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= U_pipe U_ct = U_ct + 1 segCount = segCount + 1 desLength = desLength - U_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= V_pipe V_ct = V_ct + 1 segCount = segCount + 1 desLength = desLength - V_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= W_pipe W_ct = W_ct + 1 segCount = segCount + 1 desLength = desLength - W_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= X_pipe X_ct = X_ct + 1 segCount = segCount + 1 desLength = desLength - X_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= Y_pipe Y_ct = Y_ct + 1 segCount = segCount + 1 desLength = desLength - Y_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength >= Z_pipe Z_ct = Z_ct + 1 segCount = segCount + 1 desLength = desLength - Z_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend While desLength > 0 FULLY_ct = FULLY_ct + 1 segCount = segCount + 1 desLength = desLength - FULLY_pipe If segCount >= 2 Then desLength = desLength - CS_Con + Threadin + Threadin End If Wend CS_Con_ct_p = segCount - 1 CS_Con_ct_tot = CS_Con_ct_tot + CS_Con_ct_p A_ct_tot = A_ct + A_ct_tot B_ct_tot = B_ct + B_ct_tot C_ct_tot = C_ct + C_ct_tot D_ct_tot = D_ct + D_ct_tot E_ct_tot = E_ct + E_ct_tot F_ct_tot = F_ct + F_ct_tot G_ct_tot = G_ct + G_ct_tot H_ct_tot = H_ct + H_ct_tot I_ct_tot = I_ct + I_ct_tot J_ct_tot = J_ct + J_ct_tot K_ct_tot = K_ct + K_ct_tot L_ct_tot = L_ct + L_ct_tot M_ct_tot = M_ct + M_ct_tot N_ct_tot = N_ct + N_ct_tot O_ct_tot = O_ct + O_ct_tot P_ct_tot = P_ct + P_ct_tot Q_ct_tot = Q_ct + Q_ct_tot R_ct_tot = R_ct + R_ct_tot S_ct_tot = S_ct + S_ct_tot T_ct_tot = T_ct + T_ct_tot U_ct_tot = U_ct + U_ct_tot V_ct_tot = V_ct + V_ct_tot W_ct_tot = W_ct + W_ct_tot X_ct_tot = X_ct + X_ct_tot Y_ct_tot = Y_ct + Y_ct_tot Z_ct_tot = Z_ct + Z_ct_tot FULLY_ct_tot = FULLY_ct + FULLY_ct_tot Range("C3") = CS_Con_ct Range("C4") = CS_Un_ct Range("C5") = CS_90deg_ct Range("C6") = CS_Tee_ct Range("C7") = A_ct Range("C8") = B_ct Range("C9") = C_ct Range("C10") = D_ct Range("C11") = E_ct Range("C12") = F_ct Range("C13") = G_ct Range("C14") = H_ct Range("C15") = I_ct Range("C16") = J_ct Range("C17") = K_ct Range("C18") = L_ct Range("C19") = M_ct Range("C20") = N_ct Range("C21") = O_ct Range("C22") = P_ct Range("C23") = Q_ct Range("C24") = R_ct Range("C25") = S_ct Range("C26") = T_ct Range("C27") = U_ct Range("C28") = V_ct Range("C29") = W_ct Range("C30") = X_ct Range("C31") = Y_ct Range("C32") = Z_ct Range("C33") = FULLY_ct Range("D3") = CS_Con_ct_tot Range("D4") = CS_Un_ct_tot Range("D5") = CS_90deg_ct_tot Range("D6") = CS_Tee_ct_tot Range("D7") = A_ct_tot Range("D8") = B_ct_tot Range("D9") = C_ct_tot Range("D10") = D_ct_tot Range("D11") = E_ct_tot Range("D12") = F_ct_tot Range("D13") = G_ct_tot Range("D14") = H_ct_tot Range("D15") = I_ct_tot Range("D16") = J_ct_tot Range("D17") = K_ct_tot Range("D18") = L_ct_tot Range("D19") = M_ct_tot Range("D20") = N_ct_tot Range("D21") = O_ct_tot Range("D22") = P_ct_tot Range("D23") = Q_ct_tot Range("D24") = R_ct_tot Range("D25") = S_ct_tot Range("D26") = T_ct_tot Range("D27") = U_ct_tot Range("D28") = V_ct_tot Range("D29") = W_ct_tot Range("D30") = X_ct_tot Range("D31") = Y_ct_tot Range("D32") = Z_ct_tot Range("D33") = FULLY_ct_tot continue = MsgBox("Do you have another segment?", vbQuestion + vbYesNo) Wend Call PresentThreadedCalc End Sub 
代码总是使用可能的最长的pipe段，然后迭代以查看哪个段是最长的段。
如果没有整个pipe道可以使用，但仍然有长度，它使用“完全螺纹”段完成了长度。
正如@格拉汉姆所说，逻辑不容易被忽视。 但是，将值存储在数组或字典中可能很有用。 字典的一个优点是很容易知道是否存在一个元素（ d.exist(xx) ）。 下面的代码将加载pipe道长度到一个字典，以及每一个行。 数据应该放在工作表“数据”中，从第8行开始。除了带有pipe道长度的字典外，还可以使用Connector ， Tee ， Union等键创build另一个（例如Connectors ），并且为每个键在需要时添加一个元素（类似于我在下面的代码中添加行号的方式）。 类似于Components.Item("Connector") = Components.Item("Connector")+1) 。
一旦你有字典中的数据，你可以执行比较。
编辑根据inputfind更近的pipe道
Private Sub CommandButton1_Click() Dim desLength As Long Dim lLastRow As Long Dim rMyRange As Range Dim rMyCell As Range Dim v As Variant desLength = Application.InputBox("Enter the desired end to center or center to center length", Type:=1) lLastRow = Worksheets("Data").Cells(8, 1).End(xlDown).Row '"pipes" starting at row 8 Set rMyRange = Worksheets("Data").Range("A8:A" & lLastRow) '"pipes" starting at row 8 Set d = CreateObject("scripting.dictionary") For Each rMyCell In rMyRange.Cells ThePipeLenght = Split(rMyCell.Value, """") If Not d.Exists(ThePipeLenght(0)) Then 'If not in dictionary, add it d.Add ThePipeLenght(0), rMyCell.Row End If Next rMyCell 'write dictionary just to see its contents i = 1 For Each v In d.Keys Worksheets("Data").Cells(i + 1, 6) = v Worksheets("Data").Cells(i + 1, 7) = d.Item(v) i = i + 1 Next 'Check if input matches any length. 'If not, find the nearer one If d.Exists(CStr(desLength)) Then Worksheets("Data").Cells(d.Item(CStr(desLength)), 3) = "This One" Else DifferencePre = 200 For Each v In d.Keys If v < desLength Then Difference = desLength - v If Difference < DifferencePre Then WhichOne = d.Item(v) DifferencePre = Difference End If End If Next Worksheets("Data").Cells(WhichOne, 3) = "Not exactly. This is the nearer" End If End Sub
我已经为你简化了这个过程。 在最后阅读我的笔记：
Public arrayIndex As Integer Const Threadin = 0.563 Sub GetComponents() Dim inputLength As Double, inputEnd1 As String, inputEnd2 As String, startLength As Double inputLength = Application.InputBox("Enter the desired end to center or center to center length", Type:=1) inputEnd1 = Application.InputBox("Enter End1 Connection (none, Connector, Union, 90deg, or Tee)", Type:=2) inputEnd2 = Application.InputBox("Enter End2 Connection (none, Connector, Union, 90deg, or Tee)", Type:=2) startLength = inputLength If VBA.Len(inputEnd1) <> 0 Then MapToComponentList inputEnd1 startLength = inputLength - GetEndSize(inputEnd1) + Threadin End If If VBA.Len(inputEnd2) <> 0 Then MapToComponentList inputEnd2 startLength = startLength - GetEndSize(inputEnd2) + Threadin End If GetRodComponents startLength End Sub Function GetEndSize(endType As String) As Double Dim size As Double If VBA.LCase(endType) = "connector" Then size = 2.53 ElseIf VBA.LCase(endType) = "union" Then size = 3# ElseIf VBA.LCase(endType) = "90deg" Then size = 2.25 ElseIf VBA.LCase(endType) = "tee" Then size = 2.25 End If GetEndSize = size End Function Sub MapToComponentList(item As Variant) If Not IsNumeric(item) Then If VBA.LCase(item) = "connector" Then Range("D3") = Range("D3") + 1 ElseIf VBA.LCase(item) = "union" Then Range("D4") = Range("D4") + 1 ElseIf VBA.LCase(item) = "90deg" Then Range("D5") = Range("D5") + 1 ElseIf VBA.LCase(item) = "tee" Then Range("D6") = Range("D6") + 1 End If Else Range("D" & item + 7) = Range("D" & item + rowOffset) + 1 End If End Sub Sub GetRodComponents(length As Double) Dim pipeSizes() As Variant, arrayLength As Integer pipeSizes = Array(126, 72, 60, 48, 36, 24, 22, 20, 18, 16, 14, 12, 11, 10, 9, 8, 7, 6.5, 6, 5.5, 5, 4.5, 4, 3.5, 3, 2.5, 2) arrayLength = Application.CountA(pipeSizes) - 1 If length < pipeSizes(arrayLength) Then If length <> 0 Then Range("D33") = Range("D33") + 1 End If arrayIndex = 0 Exit Sub Else If length >= pipeSizes(arrayIndex) Then Range("D" & arrayIndex + 7) = Range("D" & arrayIndex + 7) + 1 GetRodComponents length - pipeSizes(arrayIndex) Else arrayIndex = arrayIndex + 1 GetRodComponents length End If End If End Sub
笔记：
-
GetComponents是代码的入口点。 -
GetEndSize是获取最终大小来修改长度的助手 -
MapToComponentList是帮助将结束types和杆长度映射到电子表格 -
GetRodComponents是一个recursion过程，用于确定初始起始长度需要多长的杆 - 该代码假设您的s / sheet是根据您上传的图片
HTH
我build议使用工作表本身多一点，因为逻辑似乎在每一行都是一样的。 要理解编写代码的确切逻辑有点困难，但这是我使用的基本框架。
dim rowIndex as Integer dim lengthColumn as Integer dim segmentsColumn as Integer lengthColumn = 2 segmentsColumne = 3 For rowIndex = 3 to 20 ' calculate legnth here activeWorksheet.cells(rowIndex, lengthColumn).value = ... ' calculate segments here activeWorksheet.cells(rowIndex, segmentsColumn).value = ... Next
你也可以用一个while循环dynamic地查找范围的结尾，这个while循环testing一个空白单元的存在。
代码可以像这样的代码改变。
Sub ThreadedPipeCalc2() Dim desLength As Single, end1 As String, end2 As String Dim none As Single Dim segCount As Integer Dim CountRedux As Boolean, continue As Integer Dim n As Integer, z As Integer, k As Integer, m continue = 6 Dim vEnd1(1 To 7), vEnd2(1 To 7) none = 0 vEnd1(1) = 2.53 'CS_Con = 2.53 vEnd2(1) = 2.5 'SS_Con = 2.5 vEnd1(2) = 3 'CS_Un = 3 vEnd2(2) = 2.85 'SS_Un = 2.85 vEnd1(3) = 2.25 'CS_90deg = 2.25 vEnd2(3) = 2.28 'SS_90deg = 2.28 vEnd1(4) = 2.25 'CS_Tee = 2.25 vEnd2(4) = 2.26 'SS_Tee = 2.26 vEnd1(5) = 1 'CS_Flange = 1 vEnd2(5) = 1 'SS_Flange = 1 SS_Flang_red = 1.1875 SS_Cap = 1.77 Threadin = 0.563 Dim myPipe(1 To 27) myPipe(1) = 126 'a_pipe myPipe(2) = 72 'b_pipe myPipe(3) = 60 myPipe(4) = 48 myPipe(5) = 36 myPipe(6) = 24 myPipe(7) = 22 myPipe(8) = 20 myPipe(9) = 18 myPipe(10) = 16 myPipe(11) = 14 myPipe(12) = 12 myPipe(13) = 11 myPipe(14) = 10 myPipe(15) = 9 myPipe(16) = 8 myPipe(17) = 7 myPipe(18) = 6.5 myPipe(19) = 6 myPipe(20) = 5.5 myPipe(21) = 5 myPipe(22) = 4.5 myPipe(23) = 4 myPipe(24) = 3.5 myPipe(25) = 3 myPipe(26) = 2.5 myPipe(27) = 2 While continue = 6 segCount = 0 Range("C3:C32").Value = 0 Dim myCt(1 To 27) ' cs_con_ct .. A_ct,...,FULLY_cy Dim vTot vTot = Range("D3").Resize(27) desLength = Application.InputBox("Enter the desired end to center or center to center length", Type:=1) end1 = Application.InputBox("Enter End1 Connection (none, Connector, Union, 90deg, or Tee)", Type:=2) If end1 = Range("A1") Then CountRedux = True Else CountRedux = False End If end2 = Application.InputBox("Enter End2 Connection (none, Connector, Union, 90deg, or Tee)", Type:=2) Range("A1") = end2 Range("B2") = desLength Dim myEnd myEnd = Array("Connector", "Union", "90deg", "Tee") n = 0 For Each m In myEnd n = n + 1 If end1 = m Then k = n End If If end2 = m Then z = n End If Next m myCt(k) = myCt(k) + 1 If CountRedux = False Then vTot(k, 1) = vTot(k, 1) + 1 desLength = desLength - vEnd1(k) + Threadin myCt(z) = myCt(z) + 1 vTot(z, 1) = vTot(z, 1) + 1 desLength = desloength - vEnd1(k) + Threadin For i = 2 To UBound(myPipe) While desLength > myPipe(i) myCt(i) = myCt(i) + 1 segCount = segcout + 1 desLength = desLength - myPipe(i) If segCount >= 2 Then desLength = desLength - vEnd1(k) + Threadin + Threadin End If Wend Next i cs_con_ct_p = segCount - 1 vTot(1, 1) = vTot(1, 1) + cs_con_ct_p For i = 5 To UBound(vTot, 1) vTot(i, 1) = myCt(i) + vTot(i, 1) 'A_ct_tot ~ Fully_ct_tot Next i Range("c3").Resize(27) = WorksheetFunction.Transpose(myCt) Range("d3").Resize(27) = vTot continue = MsgBox("Do you have another segment?", vbQuestion + vbYesNo) Wend 'Call PresentThreadedCalc End Sub
我继续研究这个代码，并以此结束。 （它在模块的顶部被声明为明确的。）
Sub ThreadedPipeCalcNEW() On Error Resume Next ResetThreadedCalc 'above line needed for input validation 'dimension variables and set constants Dim j As Variant, k As Variant, dictCon As Object, dictPipe As Object Dim desLength As Single, desiredLength As Single, end1 As String, end2 As String Dim matTypes As Variant, myMaterial As String Dim continue As Integer, whileCount As Integer, conLooper As Integer, pipLooper As Integer Dim cell As Variant, lastRow As Variant Const Threadin = 0.563 'this is how far a pipe threads into a fitting (9/16 of an inch) 'initialize continue so that main while loop begins properly continue = vbYes 'initialize material types matTypes = Array("carbon", "stainless") 'initialize dictionaries Set dictCon = CreateObject("Scripting.Dictionary") Set dictPipe = CreateObject("Scripting.Dictionary") dictCon.CompareMode = vbTextCompare 'non-case-sensitive comparison dictPipe.CompareMode = vbTextCompare 'non-case-sensitive comparison 'populate connector dictionary dictCon.Add Key:="carbonConnector", Item:=2.53 dictCon.Add Key:="carbonUnion", Item:=3 dictCon.Add Key:="carbon90Deg", Item:=2.25 dictCon.Add Key:="carbon45Deg", Item:=0 dictCon.Add Key:="carbonTee", Item:=2.25 dictCon.Add Key:="carbonFlange", Item:=1 dictCon.Add Key:="stainlessConnector", Item:=2.5 dictCon.Add Key:="stainlessUnion", Item:=2.85 dictCon.Add Key:="stainless90Deg", Item:=2.28 dictCon.Add Key:="stainless45Deg", Item:=0 dictCon.Add Key:="stainlessTee", Item:=2.26 dictCon.Add Key:="stainlessFlange", Item:=1 dictCon.Add Key:="stainlessReducingflange", Item:=1.1875 dictCon.Add Key:="none", Item:=0 'populate pipe dictionary dictPipe.Add Key:="A_pipe", Item:=72 dictPipe.Add Key:="B_pipe", Item:=60 dictPipe.Add Key:="C_pipe", Item:=48 dictPipe.Add Key:="D_pipe", Item:=36 dictPipe.Add Key:="E_pipe", Item:=30 dictPipe.Add Key:="F_pipe", Item:=24 dictPipe.Add Key:="G_pipe", Item:=18 dictPipe.Add Key:="H_pipe", Item:=12 dictPipe.Add Key:="I_pipe", Item:=11 dictPipe.Add Key:="J_pipe", Item:=10 dictPipe.Add Key:="K_pipe", Item:=9 dictPipe.Add Key:="L_pipe", Item:=8 dictPipe.Add Key:="M_pipe", Item:=7 dictPipe.Add Key:="N_pipe", Item:=6 dictPipe.Add Key:="O_pipe", Item:=5.5 dictPipe.Add Key:="P_pipe", Item:=5 dictPipe.Add Key:="Q_pipe", Item:=4.5 dictPipe.Add Key:="R_pipe", Item:=4 dictPipe.Add Key:="S_pipe", Item:=3.5 dictPipe.Add Key:="T_pipe", Item:=3 dictPipe.Add Key:="U_pipe", Item:=2.5 dictPipe.Add Key:="FULLY_pipe", Item:=0 'really a fully threaded pipe nipple is two inches, but it needs to be used whenever there is a remainder distance 'allows user to input material type for whole system While IsError(Application.WorksheetFunction.Match(Trim(myMaterial), matTypes, 0)) myMaterial = Application.InputBox("Enter Material (carbon or stainless)", Type:=2) If myMaterial = "False" Then Exit Sub 'user clicked cancel,so exit program myMaterial = Trim(myMaterial) Wend 'begin while loop to accept user input and run calculations While continue = vbYes 'on second loop end1 will be assigned as the old end2 end1 = end2 'end2 will be reset to blank so that it is again set by user input end2 = "" 'initialize for loop component and pipe counters 'this allows the proper cell tallies to be added conLooper = 2 'set this to the connector row pipLooper = 16 'set this to the first row of pipe 'allows user to input connection types while checking for errors 'and ending the program if cancel button is pressed While IsError(Application.WorksheetFunction.Match(Trim(end1), dictCon.Keys, 0)) end1 = Application.InputBox("Enter End1 Connection" & vbCrLf & vbCrLf & _ "(none, connector, union, 90deg, 45deg, tee, flange, or reducingflange).", Type:=2) If end1 = "False" Then Exit Sub 'user clicked cancel,so exit program If end1 <> "none" Then end1 = Application.Proper(end1) end1 = myMaterial & end1 End If Wend 'accepts user input for length of segment center/end to center/end desiredLength = Application.InputBox("Enter the desired end to center or center to center length in INCHES." _ & vbCrLf & vbCrLf & "The previous length was " & CStr(desiredLength) & ".", Type:=1) desLength = desiredLength 'passes input to a dynamic number for rest of program 'this way, the previously entered length can be shown when loop run more than once 'allows user to input connection types while checking for errors 'and ending the program if cancel button is pressed While IsError(Application.WorksheetFunction.Match(Trim(end2), dictCon.Keys, 0)) end2 = Application.InputBox("Enter End2 Connection" & vbCrLf & vbCrLf & _ "(none, connector, union, 90deg, 45deg, tee, flange, or reducingflange)." _ & vbCrLf & vbCrLf & "The previous end was " & end1 & ".", Type:=2) If end2 = "False" Then Exit Sub 'user clicked cancel,so exit program If end2 <> "none" Then end2 = Application.Proper(end2) end2 = myMaterial & end2 End If Wend 'iterate through keys, check ends, add to counts, and alter desLength (aka desiredLength) by connector dimensions (accounting for threadin) For Each j In dictCon.Keys If end1 = j And whileCount = 0 Then Worksheets("Sheet1").Range("B" & CStr(conLooper)).Value = Worksheets("Sheet1").Range("B" & CStr(conLooper)).Value + 1 desLength = desLength - dictCon.Item(j) + Threadin End If If end1 = j And whileCount > 0 Then 'do not add to the component count if the end has been accounted for as end1/end2 already desLength = desLength - dictCon.Item(j) + Threadin End If If end2 = j Then 'second end is always considered new and is thus added to the count Worksheets("Sheet1").Range("B" & CStr(conLooper)).Value = Worksheets("Sheet1").Range("B" & CStr(conLooper)).Value + 1 desLength = desLength - dictCon.Item(j) + Threadin End If conLooper = conLooper + 1 Next j 'iterate through keys, handle fully threaded pipe specially, otherwise add pipe and modfify desiredLength according to pipe length 'account for the addition of connectors when more than one pipe piece is used from one connector to another For Each k In dictPipe.Keys While desLength - 1.404 >= dictPipe.Item(k) If k = "FULLY_pipe" Then Worksheets("Sheet1").Range("B" & CStr(pipLooper)).Value = Worksheets("Sheet1").Range("B" & CStr(pipLooper)).Value + 1 desLength = desLength - 2 Else Worksheets("Sheet1").Range("B" & CStr(pipLooper)).Value = Worksheets("Sheet1").Range("B" & CStr(pipLooper)).Value + 1 desLength = desLength - dictPipe.Item(k) If desLength <> 0 Then If myMaterial = "carbon" Then Worksheets("Sheet1").Range("B2").Value = Worksheets("Sheet1").Range("B2").Value + 1 'hardcoded position of connector row Else Worksheets("Sheet1").Range("B8").Value = Worksheets("Sheet1").Range("B8").Value + 1 'hardcoded position of connector row End If desLength = desLength - dictCon.Item(myMaterial & "Connector") + (2 * Threadin) End If End If Wend pipLooper = pipLooper + 1 Next k 'if there is any remaining pipe length, take care of it with a fully threaded piece; this ensures the pipe is always slightly too long instead of too short If desLength > 0 And desLength <= 1.404 Then Worksheets("Sheet1").Range("B" & CStr(pipLooper - 1)).Value = Worksheets("Sheet1").Range("B" & CStr(pipLooper - 1)).Value + 1 End If 'run again until user has no more segments 'this allows the program to build out a whole BOM continue = MsgBox("Do you have another segment?", vbQuestion + vbYesNo) 'add one to the loop count, indicating if the connector count 'must be modified since end1 is being assigned as the previous end2 whileCount = whileCount + 1 Wend 'find used range; ensures code is easier to edit lastRow = Range("B" & Rows.Count).End(xlUp).Row 'hide rows with unneeded components For Each cell In Worksheets("Sheet1").Range("B2:B" & CStr(lastRow)).Cells If cell.Value = 0 Then cell.EntireRow.Hidden = True Next End Sub
重置子function如下
Sub ResetThreadedCalc() Dim cell2 As Variant, lastRow2 As Variant 'find used range; ensures code is easier to edit lastRow2 = Worksheets("Sheet1").UsedRange.Rows.Count 'unhide rows or set values to zero For Each cell2 In Worksheets("Sheet1").Range("B2:B" & CStr(lastRow2)).Cells If cell2.Value = 0 Then cell2.EntireRow.Hidden = False Else cell2.Value = 0 End If Next End Sub
而表单被修改为
请让我知道你的想法，如果这可以做得更好！ 我很高兴继续改进。
一如既往，感谢您的帮助，build议和时间。
干杯，坦纳