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