Excel VBA for循环用于体积计算 [英] Excel VBA For Loop for Volume Calculation

问题描述

我正在创建一个程序，让农业生产者轻松计算出一个坦克的体积。我特意希望他们能够为坦克输入多个维度，并分别计算每个坦克的体积。尺寸将以逗号分隔，我希望它们被分割并放入自己的列中。然后我想要excel取每列数据，并应用体积公式来获取圆柱体积。我不知道该怎么做，而且我觉得需要循环来遍历每列，比如列1卷，列2卷等。代码如下。

 '分隔由逗号分隔的值，然后将它们放在自己的列中
 Public Sub CommaSep（）
 Selection.TextToColumns _ 
目的地：=列（3），_ 
 DataType：= xlDelimited，_ 
 TextQualifier：= xlDoubleQuote，_ 
 ConsecutiveDelimiter：= False，_ 
 Tab：= True ，_ 
分号：= False，_ 
逗号：= False，_ 
空格：= False，_ 
其他：= True，_ 
 OtherChar：= ，
 End Sub 
  

坦克尺寸的代码是

  Public Sub NoInput（）
 
 Sheets.Add.Name =隐藏信息
 
工作表（2）.Activate 
 
 Dim tankCount As Integer 
 tankCount = Application.InputBox（输入将在th中的坦克的数量e二次遏制，已知罐数量，1）
如果tankCount = False然后
调用DeleteSheets 
退出子
 Else 
 tankTotal = tankCount 
结束如果
 
 Dim knownVol As Variant 
 knownVol = Application.InputBox（输入加仑的坦克的已知体积。如果音量不知道，则输入0，已知坦克音量，0）
如果已知VOL =然后
调用DeleteSheets 
退出Sub 
 ElseIf knownVol> 0然后
 Application.Worksheets（1）.Range（A6）。Value =已知罐体积
 Application.Worksheets（1）.Range（B6）。Value = knownVol 
 'Application.Worksheets（2）.Range（A6）。Value =已知罐体积
'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坦克以英尺分隔，Diameter，1）
如果diameter = False然后
调用DeleteSheets 
退出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 Le 长度，1）
如果length = False然后
调用DeleteSheets 
退出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（输入加仑的坦克的已知体积，用逗号分隔。如果音量不知道，则输入0，已知坦克音量，0）
'如果已知Vol = False然后
'调用DeleteSheets 
'Exit Sub 
'Else 
'Application.Worksheets（1）.Range（A6）。Value =已知罐体积
'Application.Worksheets（1）.Range（B6）。Value = knownVol 
 'End If 
 
列（1）.AutoFit 
列（2）.AutoFit 
 
'调用DeleteSheets 
 
 End Sub 
  

解决方案

根据您对自己想要做什么的描述，一个模拟（希望）提供一些指导，我绝对不是一个专家，所以我确定有一个更好的方法来做所有这一切;同样，这里基本上没有验证，所以要小心。 / p>

维度将以逗号分隔，我希望将它们拆分并放入自己的列。

如果你接受用逗号分隔的输入，我说输入并将其拆分成数组，我假定长度/直径将需要精度，所以我使用这两个函数将逗号分隔的字符串输入转换为双精度数组

函数csv_to_string_array（strCSV as String）As String（）
csv_to_string_array =拆分（，& strCSV，）不知道为什么，但需要一个前导逗号，否则跳过第一个输入
End 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））
下一个i

str_to_double_array = tempDblArray（）
结束函数

然后我用这个来填充我的双打数组（使用InputBox的输入）

  dblDiameter（）= str_to_double_array（csv_to_string_array（strInputDiameter））
  

然后我想要excel来获取每列数据，并应用卷
公式来获取圆柱体积。

我也为此做了一个功能，因为它似乎是有道理的。如果需要，请随意使pi更准确。

 函数calc_cylinder_volume（dblDiameter as Double，dblLength as Double）As Double 
 calc_cylinder_volume =（Application.WorksheetFunction.Pi（）*（（dblDiameter ^ 2）/ 4）* dblLength）
结束函数
  

与那些，我设置一个 NoInput 类似于你的接受输入和转储值和体积的计算。它不会做任何太激进的事情，只需在 A1 中启动，并为每个直径和长度输入删除一行，然后为每个输入计算一个卷。

这一切都在一起。您可以将所有代码复制到单个模块中，并运行 NoInput（）来启动它。

  Option Explicit 
 
 Sub NoInput（）
 Dim strInputDiameter As String 
 strInputDiameter = Application.InputBox（Tank Diameter）'获取直径输入
 
 Dim strInputLength As String 
 strInputLength = Application.InputBox（Tank Length）'获取长度输入
 
'将逗号分隔的输入转换为双精度数组
 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 
设置rngCurrCell = ActiveSheet.Range（A1）
 
'将数组的值设置为最小值
 Dim intContainerCount As Integer 
 intContainerCount = WorksheetFunction.Min（UBound（dblDiameter），UBound（dblLength））
 
 '计算每个容器的容积，o utput 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））
 
设置rngCurrCell = rngCurrCell.Offset（0，3）
 Next i 
 End Sub 
 
函数csv_to_string_array（strCSV As String）As String（）
 csv_to_string_array =拆分（，& strCSV，，）'don'不知道为什么，但需要一个领先的逗号，否则跳过第一个输入
 End Function 
 
函数str_to_double_array（strArray（）As String）As Double（）
 Dim tempDblArray（）作为Double 
 ReDim tempDblArray（UBound（strArray））
 
 Dim i As Integer 
 For i = 1 To UBound（strArray）
 tempDblArray（i）= CDbl strArray（i））
下一个i 
 
 str_to_double_array = tempDblArray（）
结束函数
 
函数calc_cylinder_volume（dblDiameter As Double，dblLength As Double）As double 
 calc_cylinder_volume =（Application.WorksheetFunction.Pi（）*（（dblDiameter ^ 2）/ 4）* dblLength）
结束功能离子
  

I am creating a program that will allow agricultural producers easily calculate a volume of a tank. I specifically want them to be able to input multiple dimensions for their tanks and calculate the volume of each tank individually. The dimensions will be separated by a comma and I want them to be split and put into their own column. I then want excel to take each column of data and apply the volume formula to get the volume of the cylinder. I am not sure how to do that though, and I feel a loop will be needed to go through each column i.e. column 1 volume, column 2 volume, etc.The code for that is below.

'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

The code for the tank dimensions is

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

解决方案

Given your description of what you were looking to do, I built a mock up to (hopefully) provide some guidance. I'm by no means an expert, so I'm sure there's a better way to do all of this; also, there's basically no validation going on here, so be wary.

The dimensions will be separated by a comma and I want them to be split and put into their own column.

If you're accepting inputs separated by commas, I say take that input and split it into an array. I'm assuming the length/diameters will need precision, so I used these two functions to convert a comma separated string input into an array of doubles

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

Then I used them like this to fill my doubles array (using the input from InputBox)

dblDiameter() = str_to_double_array(csv_to_string_array(strInputDiameter))

I then want excel to take each column of data and apply the volume formula to get the volume of the cylinder.

I made a function for this too, since it seemed like it made sense. Feel free to make pi more accurate if you want.

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

With those, I set up a NoInput similar to yours to accept the input and dump the values and volume calculations. It doesn't do anything too radical, just starts in A1 and drops a row for each diameter and length input, then calculates a volume for each.

Here's the whole thing all together. You can just copy all of the code here into a single Module and run NoInput() to kick it off.

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 for循环用于体积计算的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！