Excel VBA排序功能输出

时间:2016-07-22 23:26:42

标签: excel vba excel-vba

我正在开展一个项目,我需要创建一个excel程序,指导农业生产者为他们的油箱创建二级安全壳。我一直在研究一个程序并且已经创建了很多程序,但遇到了一个问题。我有一个部分,如果他们有多个坦克,它将计算给定直径和长度的体积。这是该代码的片段

    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

Call Largest

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) ^ 2) * dblLength)
End Function

Sub Largest()
'Cells with dates also return a value, and get covered for determining largest value. Percentages will convert and return numerics.

Dim rng As Range
Dim dblMax As Double

'Set range from which to determine largest value
Set rng = Sheet1.Range("A1:Z100")

'Worksheet function MAX returns the largest value in a range
dblMax = Application.WorksheetFunction.Max(rng)

'Displays largest value
MsgBox dblMax


End Sub

然后我想使用最大音量并根据它是垂直或水平坦克来解决公式。水平或垂直水箱的容积公式不同。我需要一种方式,我可以以msgbox的形式询问它是否为水平或垂直,然后将该结果附加到该坦克。所以例如第一列有:"直径:12长度:12方向:垂直"。柱2具有:"直径:8长度:12方向:水平"。一旦我知道了坦克的方向,那么我就可以确定我需要用来解决方程的适当体积公式。

1 个答案:

答案 0 :(得分:0)

我找到了办法。这是代码。它可能不是很漂亮(虽然不是一个很好的编码器,但是它有点像一个更好的工程师),但它确实有效。

User.new