Excel VBA for Loop計算體積

Question

我正在創建一個程序，可以讓農業生產者輕鬆計算一個罐的體積。我特別希望他們能夠爲他們的坦克輸入多個維度並分別計算每個坦克的體積。尺寸將以逗號分隔，我希望將它們拆分並放入自己的列中。然後，我希望excel能夠獲取每列數據並應用體積公式來獲取圓柱體的體積。我不知道該怎麼做，但我覺得需要循環遍歷每一列，例如第1列的音量，第2列的音量等。下面是代碼。

'Seperates values that are seperated by a comma and then puts them in their own column 
Public Sub CommaSep() 
    Selection.TextToColumns _ 
     Destination:=Columns(3), _ 
     DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, _ 
     ConsecutiveDelimiter:=False, _ 
     Tab:=True, _ 
     Semicolon:=False, _ 
     Comma:=False, _ 
     Space:=False, _ 
     Other:=True, _ 
     OtherChar:="," 
End Sub 

的罐尺寸的代碼是

Public Sub NoInput() 

Sheets.Add.Name = "Hidden Information" 

Worksheets(2).Activate 

Dim tankCount As Integer 
tankCount = Application.InputBox("Enter the Number of Tanks that will be in the Secondary Containment", "Known Tank Quantity", 1) 
If tankCount = False Then 
    Call DeleteSheets 
    Exit Sub 
Else 
    tankTotal = tankCount 
End If 

Dim knownVol As Variant 
knownVol = Application.InputBox("Enter the Known Volume of the Tank in Gallons. If volume is not known then enter 0", "Known Tank Volume", 0) 
If knownVol = "" Then 
    Call DeleteSheets 
    Exit Sub 
ElseIf knownVol > 0 Then 
    Application.Worksheets(1).Range("A6").Value = "Known Tank Volume" 
    Application.Worksheets(1).Range("B6").Value = knownVol 
' Application.Worksheets(2).Range("A6").Value = "Known Tank Volume" 
' Application.Worksheets(2).Range("B6").Value = knownVol 
' Call SPCCSizedSecondary 
' Exit Sub 
Else 
End If 


Dim diameter As Variant 
diameter = Application.InputBox("Enter the Diameter of the Tanks in feet seperated by commas", "Diameter", 1) 
If diameter = False Then 
    Call DeleteSheets 
    Exit Sub 
Else 
    Application.Worksheets(1).Range("A4").Value = "Diameter" 
    Application.Worksheets(1).Range("B4").Value = diameter 
End If 


Dim length As Variant 
length = Application.InputBox("Enter the Length of the Tanks in feet seperated by commas", "Length", 1) 
If length = False Then 
    Call DeleteSheets 
    Exit Sub 
Else 
    Application.Worksheets(1).Range("A5").Value = "Length" 
    Application.Worksheets(1).Range("B5").Value = length 
End If 

'Dim knownVol As Variant 
'knownVol = Application.InputBox("Enter the Known Volume(s) of the Tank in Gallons seperated by commas. If volume is not known then enter 0", "Known Tank Volume", 0) 
'If knownVol = False Then 
' Call DeleteSheets 
' Exit Sub 
'Else 
' Application.Worksheets(1).Range("A6").Value = "Known Tank Volume" 
' Application.Worksheets(1).Range("B6").Value = knownVol 
'End If 

Columns(1).AutoFit 
Columns(2).AutoFit 

'Call DeleteSheets 

End Sub 

Answer 1

鑑於你的是你所希望做的介紹，我建立了一個模擬最多（希望）提供一些指導。我絕不是專家，所以我確信有更好的方法來做到這一點;此外，這裏基本沒有驗證，所以要謹慎。

尺寸將用逗號分開，我希望他們能夠被分割並投入自己的列。

如果您接受以逗號分隔的輸入，我會採用該輸入並將其拆分爲數組。我假定長度/直徑將需要的精度，所以就用這兩個函數以逗號分隔的字符串輸入轉換成雙打

Function csv_to_string_array(strCSV as String) As String() 
    csv_to_string_array = Split("," & strCSV, ",") 'don't know why, but needs a leading comma otherwise it skips the first input 
End Function 

Function str_to_double_array(strArray() as String) As Double() 
    Dim tempDblArray() As Double 
    ReDim tempDblArray(UBound(strArray)) 

    Dim i As Integer 
    For i = 1 To UBound(strArray) 
     tempDblArray(i) = CDbl(strArray(i)) 
    Next i 

    str_to_double_array = tempDblArray() 
End Function 

然後我用他們這樣填補我雙打陣列的陣列（使用從的InputBox輸入）

dblDiameter() = str_to_double_array(csv_to_string_array(strInputDiameter)) 

然後我希望Excel取數據的每一列，並將其中體積 公式來獲得所述氣缸的容積。

我也爲此做了一個函數，因爲它看起來很有意義。如果你願意，可以隨時讓pi更準確。

Function calc_cylinder_volume(dblDiameter as Double, dblLength as Double) As Double 
    calc_cylinder_volume = (Application.WorksheetFunction.Pi() * ((dblDiameter^2)/4) * dblLength) 
End Function 

有了這些，我建立一個類似你這樣的NoInput接受輸入並轉儲值和體積計算。它不會做任何太激進的事情，只需從A1開始，然後爲每個直徑和長度輸入刪除一行，然後計算每個音量。

這是整個事情在一起。您可以將所有代碼複製到一個模塊中，然後運行NoInput()來啓動它。

Option Explicit 

Sub NoInput() 
    Dim strInputDiameter As String 
    strInputDiameter = Application.InputBox("Tank Diameter") 'get diameter inputs 

    Dim strInputLength As String 
    strInputLength = Application.InputBox("Tank Length") 'get length inputs 

    'convert comma separated inputs to arrays of Doubles 
    Dim dblDiameter() As Double 
    dblDiameter() = str_to_double_array(csv_to_string_array(strInputDiameter)) 
    Dim dblLength() As Double 
    dblLength() = str_to_double_array(csv_to_string_array(strInputLength)) 


    Dim rngCurrCell As Range 
    Set rngCurrCell = ActiveSheet.Range("A1") 

    'set number of containers to whichever input had the least values 
    Dim intContainerCount As Integer 
    intContainerCount = WorksheetFunction.Min(UBound(dblDiameter), UBound(dblLength)) 

    'calculate volume for each container, output to sheet 
    Dim i As Integer 
    For i = 1 To intContainerCount 
     rngCurrCell.Value = "Diameter " & i 
     rngCurrCell.Offset(0, 1).Value = dblDiameter(i) 

     rngCurrCell.Offset(1, 0).Value = "Length " & i 
     rngCurrCell.Offset(1, 1).Value = dblLength(i) 

     rngCurrCell.Offset(2, 0).Value = "Volume " & i 
     rngCurrCell.Offset(2, 1).Value = calc_cylinder_volume(dblDiameter(i), dblLength(i)) 

     Set rngCurrCell = rngCurrCell.Offset(0, 3) 
    Next i 
End Sub 

Function csv_to_string_array(strCSV As String) As String() 
    csv_to_string_array = Split("," & strCSV, ",") 'don't know why, but needs a leading comma otherwise it skips the first input 
End Function 

Function str_to_double_array(strArray() As String) As Double() 
    Dim tempDblArray() As Double 
    ReDim tempDblArray(UBound(strArray)) 

    Dim i As Integer 
    For i = 1 To UBound(strArray) 
     tempDblArray(i) = CDbl(strArray(i)) 
    Next i 

    str_to_double_array = tempDblArray() 
End Function 

Function calc_cylinder_volume(dblDiameter As Double, dblLength As Double) As Double 
    calc_cylinder_volume = (Application.WorksheetFunction.Pi() * ((dblDiameter^2)/4) * dblLength) 
End Function