長碼需要數組

自從我處理VBA以來，我已經有一段時間了，而且我寫了一些相當不雅的東西。長碼需要數組

有人可以提出一種方法來縮短以下代碼嗎？我想陣列可以幫助，但我不知道如何實現它。

該代碼的目的是建立螺紋管道系統，它必須以相當精確的長度進行組合。程序總是使用最大長度的管道，以適應所需管道長度的剩餘量。

爲了保持代碼儘可能短，我省略了維度變量和顯示結果的部分。

在此先感謝您的幫助。

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

代碼總是使用最長的管段可能並循環向下，看看哪些是適合最長的部分。

如果沒有使用整個管道，但仍然有長度，它使用「完全螺紋」部分，完成了長度。

來源

2017-06-16 tannman357

你能解釋一下關於它如何工作？最終產出是什麼，以及每個階段的結果如何？ – Graham

請參閱編輯。程序填寫此表格，告訴用戶哪些管道長度和部件將滿足所需的測量。 – tannman357

程序如何處理同一長度的多個解決方案？例如：如果我需要80「管道，那麼它可能是1×72」+ 1×8「管道或4×20」管道或1×60「+ 1×20」管道...... –

我繼續研究這個代碼，最終得到了這個結果。（它的聲明在模塊的頂部明確。）

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

復位子功能如下

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

而且片修改爲

請讓我知道你的想法，如果這可以做得更好！我很樂意繼續改進。

一如既往，感謝您的所有幫助，建議和時間。

乾杯，坦納

來源

2017-06-21 18:48:05 tannman357

我建議使用工作表本身多一點，因爲邏輯似乎是在每一行相同。對於編寫代碼來說，理解確切的邏輯有點困難，但這是我使用的基本框架。

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循環動態地查找範圍的結尾，測試是否存在空白單元格。

來源

2017-06-16 14:02:24 Graham

正如@Graham所說，邏輯不容易被忽視。但是，將值存儲在數組或字典中可能很有用。字典的一個優點是很容易知道是否存在元素（d.exist(xx)）。以下代碼將管道長度加載到字典以及每一行的行中。數據應該在工作表「數據」中，從第8行開始。除了帶管道長度的字典外，還可以使用密鑰Connector,Tee,Union等創建另一個（例如Connectors），並且對於每個鍵在需要時添加一個元素（類似於我在下面的代碼中添加行號的方式）。類似於Components.Item("Connector") = Components.Item("Connector")+1)。

一旦你在字典中有數據，你可以執行比較。

被修改根據輸入

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

來源

2017-06-16 14:44:45 CMArg

我選擇這個作爲答案，因爲我結束了使用字典。我的最終代碼是非常不同的，但謝謝你的提示！ – tannman357

很高興幫助。無論如何，考慮到這是完全合法的在這個網站上發佈一個答案，你自己的問題。 – CMArg

我的代碼現在發佈爲答案。告訴我你對它的想法。 – tannman357

的代碼查找較近的管可以改變這樣的代碼。

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

來源

2017-06-16 16:29:36

我已經爲你簡化了這個過程。不要在最後讀我的筆記：

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是一個輔助到端類型和杆長度映射到電子表格
GetRodComponents是遞歸過程推測杆的什麼長度需要給予最初的起始長度
該代碼假定您的S /片是按您的上傳的圖像

HTH

來源

2017-06-16 20:43:56

長碼需要數組

回答

相關問題