2016-07-22 2 views
1

저는 농업 생산자가 쉽게 탱크의 양을 계산할 수있는 프로그램을 만들고 있습니다. 나는 그들에게 탱크의 여러 치수를 입력하고 각 탱크의 부피를 개별적으로 계산할 수 있어야한다. 치수는 쉼표로 구분되며 필자는 분할하여 고유 한 열에 넣기를 원합니다. 그런 다음 데이터의 각 열을 가져 와서 볼륨 공식을 적용하여 실린더의 볼륨을 얻는 것이 좋습니다. 그래도 어떻게해야할지 모르겠다. 각 열, 즉 열 1 볼륨, 열 2 볼륨 등을 순환하는 데 필요한 루프가 있다고 느낀다. 그 코드는 아래에있다.Excel VBA for Loop for Volume Calculation

'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 

답변

0

은 당신이 찾고 있던 무슨 당신의 설명을 감안할 때, 나는까지 (희망) 몇 가지 지침을 제공하는 모의를 구축합니다. 나는 전문가가 아니기 때문에이 모든 것을 할 수있는 더 좋은 방법이 있다고 확신합니다. 또한 여기에는 기본적으로 유효성 검사가 수행되지 않으므로주의하십시오.

크기는 쉼표로 구분되며 분할하여 고유 한 열에 넣기를 원합니다.

쉼표로 구분 된 입력을 수락하는 경우 해당 입력을 가져 와서 배열로 분할합니다. 내가 (사용 복식

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)) 

각 데이터 열을 실린더의 부피를 얻기 위해 볼륨을 수식을 적용하는 엑셀.

나는 이것도 의미가있는 것처럼 보였으므로이 기능도 만들었습니다. 원한다면 파이를 더 정확하게 만들 수 있습니다. 그와

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 
+0

답장을 보내 주셔서 감사합니다. 내 전체 Excel VBA 프로그래밍에 대한 나의 새로운 기능으로 인해, 내 루틴에 함수를 구현하는 방법을 너무 확신하지 못합니다. 나는 Function 대신 Sub를 사용하는 것에 만 익숙하다. 매크로 생성 과정에서 어떻게 사용하는지 아이디어를 주시겠습니까? – JuliusDariusBelosarius

+0

@JuliusDariusBelosarius 여기에 모든 것을 집어 넣는 방법을 명확히하기 위해 편집을 추가하겠습니다. 이 함수를 사용하려면 Sub 아래에 복사하여 붙여 넣기 만하면됩니다. Function에서 End Function으로 전체 함수를 복사하고 마지막 End Sub 바로 아래에 붙여 넣으십시오. 그럼, 당신은 단지'calc_cylinder_volume (dblDiameter (i), dblLength (i))' – Etheur

+1

처럼 하위 내에서 함수를 참조 할 수 있습니다. 그냥 사용하면 추가 할 수 있습니다 : Application.WorksheetFunction.Pi()를 얻으려면 –