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

用于体积计算的循环的Excel VBA

1 个答案: