프로그램 설명
설계자가 원하는 맨홀규격(타입) 및 높이에 따라 조립식 PC맨홀 하부구체, 상부구체, 연직구체의 최적 조합을 찾는 VBA 매크로 입니다. 아무쪼록 없는 실력으로 어렵게 만들었고 원하는 처리 속도보다 빠르지 않지만 필요한 분들께 도움 됬으면 좋겠습니다.
제가 설정한 최적 조합의 기준은 계획맨홀 높이에 부합하는 하부구체, 상부구체, 연직구체의 조합을 모두 구한 후 구체수가 가장 적은 조합을 선택하며(구체수가 많으면 설치비가 증가하므로), 가장 적은 조합 중 구체수가 동일한 조합이 있을 경우 조합된 각 구체의 총 자재가격을 비교해 가장 낮은 가격의 조합을 선택하는 것 입니다.
자세한 내용은 아래 설명 및 동영상(자막, 목소리 없음) 참조
엑셀 Sheet설명
<dataSheet> 시트
VBA 코드 작동을 위한 기초 자료가 저장된 시트로 조립식 PC맨홀의 규격별 하부구체, 상부구체, 연직구체에 대한 치수(dim)와 자재 가격(price)을 입력하며 데이터 입력은 다음과 같이 이루어져야 합니다:
- 각각의 규격(예: 원형맨홀 1호, 2호...)에 대한 하부구체(lower), 상부구체(upper), 연직구체(vertical)의 치수(dim)와 가격(price)을 행 방향으로 기입합니다. 총 6개의 맨홀타입 입력 가능 (하부구체에는 관로가 연결되므로 연결 관로의 외경, 관로 삽입을 위한 구멍을 고려해 적용하고자 하는 하부구체의 높이를 입력합니다. 또한 유입, 유출관의 단차가 높은 경우 조립식 PC맨홀 사용이 불가하니 유념하시기 바랍니다.)
- 행 방향으로 데이터를 입력할 때, 빈 셀을 포함해서는 안 됩니다. 모든 치수와 가격 정보가 짝을 이뤄 순서대로 입력되어야 합니다.
- 기존에 작성된 데이터(물가자료 2023년 7월호 특정 회사 제품, 업체 정보는 삭제)를 원하는 제품의 치수와 가격 정보로 대체하면 됩니다. 예를 들어, 다른 회사의 제품 정보로 수정하거나, 원하는 제품의 규격에 따라 치수와 가격을 입력할 수 있습니다.
이렇게 데이터를 입력하고 실행하면, 입력한 제품의 정보를 기반으로 VBA 매크로가 최적의 조합을 찾게 됩니다.
<개별체크>시트
맨홀 1개에 대해 맨홀의 타입과 높이를 설정하여조립식 PC 맨홀의 하부구체, 상부구체, 연직구체 조합을 확인하고 최적 조합을 검토할 수 있습니다. 조합 결과는 다음과 같이 작동합니다:
- 하부구체(L)와 상부구체(U)의 모든 조합을 구합니다. 이때, 계획한 맨홀 높이와 일치하는 조합이 있으면 연직구체(V)는 필요 없으므로 연직구체의 수량(V)은 비워두고, 연직구체의 가격(vprice)은 0으로 설정됩니다.
- 하부구체(L)와 상부구체(U)의 모든 조합을 구한 후 연직구체(V)와의 조합을 내부적으로 수행하고, 조합되는 결과가 있을 경우 최적 조합을 선택해 최적 조합만 연직구체 수량(V) 및 연직구체 가격(vprice)을 표시합니다.(연직구체의 조합은 경우의 수가 너무 많아 모든 내부 수행 결과는 따로 표시하지 않고 최적 조합만 출력합니다.)
- 계산 결과에서 연직구체의 가격(vprice), 총 자재 가격(totalprice), 구체 전체 수량(piece) 값이 있는 경우, 계획한 맨홀 높이에 대한 조합이 가능한 경우입니다. 최적 조합은 그 중에서 구체 전체 수량(piece)이 가장 적은 경우를 선택하며, 구체 전체 수량이 동일한 경우에는 그 중에서 총 자재가격(totalprice)가 낮은 조합을 선택합니다.
<일괄체크> 시트
지정된 맨홀타입에 대해 맨홀높이가 여러개일 경우 PC맨홀 하부구체, 상부구체, 연직구체의 최적 조합만을 일괄 확인할 경우 사용합니다. (수량산출시 용이)
단순히 위의 <개별체크>가 하는 기능을 입력한 복수의 높이값에 대해 루프를 돌면서 처리하며 그에따라 처리 시간이 오래 걸립니다.
계획맨홀 높이의 입력범위는 A10:A입니다.(마지막 입력범위까지 계산)
조작설명
기본 단위는 m입니다.
조립식 PC맨홀은 기성제품으로 구체의 높이는 보통 0.1m 단위로 규격화된 제품으로 0.01m 단위인 계획맨홀 높이를 맞출 수 없으므로 허용오차(공차)를 설정해야 합니다. 사용자가 입력할 수 있는 허용오차 입력 범위는 0.0001m(엑셀의 부동소수점 계산 오류 방지, 허용오차를 0으로 설정하고 싶다면 0.0001 입력)~0.05m(기성 제품임을 감안한 반올림 고려)까지로 보통 반올림 생각해서 0.03~0.05로 설정해 사용하면 되고 이 오차값은 따로 사용자가 수량산출시 높이조절 콘크리트에 반영하면 됩니다.
dataSheet에 기초 데이터 입력 후 <개별체크> 및 <일괄체크> 시트내 맨홀타입번호(입력값 1~6) 및 맨홀높이(맨홀높이는 10m이하) 설정 후 실행버튼을 눌러 실행합니다.
입력한 계획맨홀의 높이는 소수점 2자리까지 반올림(round(height,2) 처리 후 계산됩니다.
일반적으로 설계시 맨홀높이는 맨홀바닥에서 맨홀뚜껑 상단까지의 높이입니다. 그러나 본 VBA에서 맨홀높이는 제품 제조사 기준인 "조립식 PC맨홀 높이" 입니다. 수량산출로 이용시 착오 없기를 바랍니다.
- 일반적인 맨홀높이 = 맨홀 벽체 높이 + 맨홀 슬라브 높이 + 높이조절 콘크리트 높이 + 맨홀 뚜껑 높이
- 조립식 PC맨홀높이 = 하부구체 높이 + 상부구체높이 + 연직구체 높이 = 맨홀 벽체 높이 + 맨홀 슬라브 높이
- 일반적인 맨홀높이 = 높이조절콘크리트 높이 + 맨홀뚜껑 높이 + 조립식 PC맨홀 높이
표시결과 테이블 머리글 설명
- L : 하부구체의 수량
- U : 상부구체의 수량
- V : 연직구체의 수량
- vprice : 연직구체의 자재비(구체가 여러개일 경우 각 구체 자재비의 합)
- uprice : 상부구체의 자재비
- lprice : 하부구체의 자재비
- totalprice : vprice, uprice, lprice의 합
- piece : L, U, V 구체 수량의 합
- H : L, U, V 구체 높의의 합
- deltaH : 계획맨홀 높이(height)와 조합된 조립식 PC맨홀 높이(H)의 차
위에서도 언급했지만 vprice값이 표시된 행이(연직구체가 필요없는 vprice가 0인 경우 포함) 허용오차내에서 조합이 된 경우입니다. vprice가 빈 셀인 경우는 허용오차내에서 조합이 되지 않은 경우로 허용오차값을 조정하거나 <개별체크>시트를 참고해 사용자가 수작업으로 수정하시기 바랍니다.
사용시 유의사항
- 코드는 엑셀 2010에서 작성되었고, 해당 버전에서 정상적으로 작동합니다. (일반적으로 엑셀의 상위 버전에서도 호환성이 유지될 것입니다.)
- 코드를 사용함으로써 발생하는 오류나 문제에 대해서는 사용자 본인이 책임을 집니다.
- 또한 본 코드는 대규모 데이터 세트의 경우 실행 시간이 오래 걸리거나 오류가 발생할 수 있습니다.(dataSheet에 입력된 조립식 PC맨홀 구체의 갯수가 많은 경우, 계획맨홀 높이가 높을 경우, 일괄조회 할 맨홀의 수량이 많은 경우 등 조합할 경우의 수가 많을수록 시간이 오래 걸립니다.)
- 코드를 수정하고 출처를 표시하여 배포하는 것은 자유롭게 가능합니다. 그러나 상업적인 목적으로 이용하는 것은 허용되지 않습니다.
- 이상현상 발생시 댓글달아주세요.
다운로드
코드
module1
Option Explicit
Public Sub batchCombi()
Dim dataSheet As Worksheet
Dim ws As Worksheet
Set dataSheet = ThisWorkbook.Sheets("dataSheet")
Set ws = ThisWorkbook.Sheets("일괄체크")
Dim i As Long
Dim j As Long
' 허용오차 설정
Dim tolerance As Double
tolerance = Range("B2").Value
If tolerance < 0.0001 Or tolerance > 0.05 Then
MsgBox "허용오차 값은 0.0001(부동소수점 오류 방지)과 0.05(기성 제품 사이즈 허용오차)사이의 범위에 속해야 합니다."
Exit Sub
End If
' 맨홀타입 설정
Dim manholeType As Variant
manholeType = Range("B3").Value
If Not IsNumeric(manholeType) Then
MsgBox "숫자가 아닙니다."
Exit Sub
End If
' 맨홀높이값 범위 설정
Dim heightRange As Range
Dim hCell As Range
Set heightRange = ws.Range("A10:A" & ws.Cells(ws.Rows.count, "A").End(xlUp).row)
For Each hCell In heightRange.Cells
If Not IsNumeric(hCell.Value) Then
MsgBox hCell.Address & " 셀에 숫자가 아닌 값이 있습니다.", vbExclamation
Exit Sub
End If
If hCell.Value > 10 Then
MsgBox hCell.Address & " 셀값이 너무 큽니다 10이하로 설정하세요.", vbExclamation
Exit Sub
End If
Next hCell
' dataSheet에서 데이터 읽어오기
Dim columnOffset As Long
Dim lower() As Double
Dim lprice() As Double
Dim upper() As Double
Dim uprice() As Double
Dim vertical() As Double
Dim vprice() As Double
columnOffset = getColumnOffset(manholeType)
On Error Resume Next
readDataFromWorksheet dataSheet, lower, lprice, upper, uprice, vertical, vprice, columnOffset
On Error GoTo 0
' dataSheet의 자료입력 확인
If isUnfit(lower) Or isUnfit(lprice) Or isUnfit(upper) Or isUnfit(uprice) Or isUnfit(vertical) Or isUnfit(vprice) Then
MsgBox dataSheet.Name & "에 해당 맨홀자료 입력이 되어 있지않거나 요구되는 입력형식이 아닙니다.", vbExclamation
Exit Sub
End If
' 출력위치 설정 및 셀내용 삭제
Dim outputRange As Range
Dim clearRange As Range
Dim tableTitleOutputRange As Range
Set tableTitleOutputRange = ws.Range("B8")
Set clearRange = tableTitleOutputRange.Resize(heightRange.Rows.count + 2, 30)
clearRange.Interior.ColorIndex = xlNone
clearRange.ClearContents
' TableTitle 작성 및 출력
Dim tableTitle() As Variant
Dim colIndex As Long
genTableTitle lower, upper, vertical, tableTitle, colIndex
Set outputRange = tableTitleOutputRange.Resize(2, colIndex + 6)
outputRange.Interior.Color = RGB(255, 255, 0)
outputRange.Value = tableTitle
Dim lowupDict As Object
Dim verticalDict As Object
Dim targetDict As Object
Dim target As Double
Set lowupDict = CreateObject("Scripting.Dictionary")
Set verticalDict = CreateObject("Scripting.Dictionary")
Set targetDict = CreateObject("Scripting.Dictionary")
Dim outterArr() As Variant
Dim numRows As Long
Dim numCols As Long
Dim tkey As Variant
For Each hCell In heightRange.Cells
' lower/upper 조합 생성 및 딕셔너리에 저장
For i = LBound(lower) To UBound(lower)
For j = LBound(upper) To UBound(upper)
lowupDict(lowupDict.count + 1) = Array(lower(i), upper(j))
target = Round(hCell.Value, 2) - lower(i) - upper(j)
If Not withinTolerance(target, 0, tolerance) Then
targetDict(targetDict.count) = target
Else
targetDict(targetDict.count) = 0
End If
Next j
Next i
numRows = lowupDict.count
numCols = UBound(lower) + UBound(upper) + UBound(vertical) + 7
ReDim outterArr(1 To numRows, 1 To numCols)
' lower/upper 데이터 구성
lowupCombinations lowupDict, 0, lower, lprice, outterArr, 0, numCols - 4
lowupCombinations lowupDict, 1, upper, uprice, outterArr, UBound(lower), numCols - 5
' vertical 데이터 구성
For Each tkey In targetDict.Keys
Dim minRow As Long
processTargetKey targetDict, tkey, lower, upper, vertical, vprice, outterArr, numCols, tolerance, verticalDict
Next tkey
' totalprice 산정 및 구체의 개수 산출
genInfo outterArr, tableTitle, numRows, numCols, Round(hCell.Value, 2)
' 구체의 개수가 가장 적은 것 중 가장 저렴한 구성 선택(구체의 갯수가 많으면 설치비 증가)
Dim isEmptyColumn As Boolean
isEmptyColumn = True
For i = 1 To numRows
If Not IsEmpty(outterArr(i, numCols - 2)) Then
isEmptyColumn = False
Exit For
End If
Next i
If Not isEmptyColumn Then
minRow = findOptRow(outterArr, 1, numCols - 2, numCols - 3)
Set outputRange = ws.Cells(hCell.row, "B").Resize(1, numCols)
For i = 1 To numCols
outputRange.Cells(1, i).Value = outterArr(minRow, i)
Next i
End If
' 데이터초기화
ReDim outterArr(0)
ReDim dataArr(0)
lowupDict.RemoveAll
verticalDict.RemoveAll
targetDict.RemoveAll
Next hCell
End Sub
Public Sub indiCombi()
Dim dataSheet As Worksheet
Dim ws As Worksheet
Set dataSheet = ThisWorkbook.Sheets("dataSheet")
Set ws = ThisWorkbook.Sheets("개별체크")
Dim i As Long
Dim j As Long
' 허용오차 설정
Dim tolerance As Double
tolerance = Range("B2").Value
If tolerance < 0.0001 Or tolerance > 0.05 Then
MsgBox "허용오차 값은 0.0001(부동소수점 오류 방지)과 0.05(기성 제품 사이즈 허용오차)사이의 범위에 속해야 합니다."
Exit Sub
End If
' 맨홀타입 설정
Dim manholeType As Variant
manholeType = Range("B3").Value
If Not IsNumeric(manholeType) Then
MsgBox "맨홀타입은 지정된 숫자로 입력하세요."
Exit Sub
End If
' 맨홀높이 설정
Dim height As Double
height = Range("B4").Value
If Not IsNumeric(height) And height > 10 Then
MsgBox "숫자가 아니거나 맨홀높이가 10 이상입니다."
Exit Sub
End If
' dataSheet에서 데이터 읽어오기
Dim columnOffset As Long
Dim lower() As Double
Dim lprice() As Double
Dim upper() As Double
Dim uprice() As Double
Dim vertical() As Double
Dim vprice() As Double
columnOffset = getColumnOffset(manholeType)
On Error Resume Next
readDataFromWorksheet dataSheet, lower, lprice, upper, uprice, vertical, vprice, columnOffset
On Error GoTo 0
' dataSheet의 자료입력 확인
If isUnfit(lower) Or isUnfit(lprice) Or isUnfit(upper) Or isUnfit(uprice) Or isUnfit(vertical) Or isUnfit(vprice) Then
MsgBox dataSheet.Name & "에 해당 맨홀자료 입력이 되어 있지않거나 요구되는 입력형식이 아닙니다.", vbExclamation
Exit Sub
End If
' 출력위치 설정
Dim outputRange As Range
Dim clearRange As Range
Dim tableTitleOutputRange As Range
Set tableTitleOutputRange = ws.Range("B10")
Set clearRange = ws.Range("B10").Resize(42, 30)
clearRange.Interior.ColorIndex = xlNone
clearRange.ClearContents
Set clearRange = ws.Range("B8").Resize(1, 30)
clearRange.Interior.ColorIndex = xlNone
clearRange.ClearContents
' TableTitle 작성 및 출력
Dim tableTitle() As Variant
Dim colIndex As Long
genTableTitle lower, upper, vertical, tableTitle, colIndex
Set outputRange = tableTitleOutputRange.Resize(2, colIndex + 6)
outputRange.Interior.Color = RGB(255, 255, 0)
outputRange.Value = tableTitle
Dim lowupDict As Object
Dim verticalDict As Object
Dim targetDict As Object
Dim target As Double
Set lowupDict = CreateObject("Scripting.Dictionary")
Set verticalDict = CreateObject("Scripting.Dictionary")
Set targetDict = CreateObject("Scripting.Dictionary")
Dim numRows As Long
Dim numCols As Long
Dim tkey As Variant
' lower/upper 조합 생성 및 딕셔너리에 저장
For i = LBound(lower) To UBound(lower)
For j = LBound(upper) To UBound(upper)
lowupDict(lowupDict.count + 1) = Array(lower(i), upper(j))
target = Round(height, 2) - lower(i) - upper(j)
If Not withinTolerance(target, 0, tolerance) Then
targetDict(targetDict.count) = target
Else
targetDict(targetDict.count) = 0
End If
Next j
Next i
numRows = lowupDict.count
numCols = UBound(lower) + UBound(upper) + UBound(vertical) + 7
Dim outterArr() As Variant
ReDim outterArr(1 To numRows, 1 To numCols)
' lower/upper 데이터 구성
lowupCombinations lowupDict, 0, lower, lprice, outterArr, 0, numCols - 4
lowupCombinations lowupDict, 1, upper, uprice, outterArr, UBound(lower), numCols - 5
' vertical 데이터 구성
For Each tkey In targetDict.Keys
Dim minRow As Long
processTargetKey targetDict, tkey, lower, upper, vertical, vprice, outterArr, numCols, tolerance, verticalDict
Next tkey
' totalprice 산정 및 구체의 개수 산출
genInfo outterArr, tableTitle, numRows, numCols, Round(height, 2)
' 전체 데이터 출력
Set outputRange = ws.Range("B12").Resize(numRows, numCols)
outputRange.Value = outterArr
' 구체의 개수가 가장 적은 것 중 가장 저렴한 구성 선택(구체의 갯수가 많으면 설치비 증가)
Dim isEmptyColumn As Boolean
isEmptyColumn = True
For i = 1 To numRows
If Not IsEmpty(outterArr(i, numCols - 2)) Then
isEmptyColumn = False
Exit For
End If
Next i
If isEmptyColumn Then
Exit Sub
Else
minRow = findOptRow(outterArr, 1, numCols - 2, numCols - 3)
Set outputRange = ws.Range("B8").Resize(1, numCols)
outputRange.Interior.Color = RGB(0, 255, 0)
For i = 1 To numCols
outputRange.Cells(1, i).Value = outterArr(minRow, i)
Next i
End If
End Sub
Private Sub vertialCombinations(ByRef arr() As Double, ByVal target As Double, ByVal currentCombo As String, ByVal remainingTarget As Double, ByVal lastIndex As Long, ByRef vprice() As Double, ByRef verticalDict As Object, ByRef tolerance As Double)
Dim i As Long
Dim comboStr As String
Dim comboArr() As String
Dim uniqueArr() As String
Dim countArr() As Long
Dim uniqueIndex As Long
Dim prevValue As String
Dim count As Long
Dim result As String
Dim areValuesWithinTolerance As Boolean
areValuesWithinTolerance = withinTolerance(remainingTarget, 0, tolerance)
If areValuesWithinTolerance And Not currentCombo = vbNullString Then
comboStr = currentCombo
comboArr = Split(comboStr, "+")
ReDim uniqueArr(UBound(comboArr))
ReDim countArr(UBound(comboArr))
uniqueIndex = 0
prevValue = vbNullString
count = 0
For i = 0 To UBound(comboArr)
If comboArr(i) = prevValue Then
count = count + 1
Else
If prevValue <> vbNullString Then
uniqueArr(uniqueIndex) = prevValue
countArr(uniqueIndex) = count + 1
uniqueIndex = uniqueIndex + 1
End If
prevValue = comboArr(i)
count = 0
End If
Next i
uniqueArr(uniqueIndex) = prevValue
countArr(uniqueIndex) = count + 1
result = vbNullString
For i = 0 To uniqueIndex
If result <> vbNullString Then
result = result & " + "
End If
result = result & uniqueArr(i) & "*" & countArr(i)
Next i
verticalDict(verticalDict.count + 1) = result
ElseIf remainingTarget < 0 Then
Exit Sub
Else
Dim usedValues As Object
Set usedValues = CreateObject("Scripting.Dictionary")
For i = lastIndex To UBound(arr)
If currentCombo = vbNullString Or Not usedValues.Exists(CStr(arr(i))) Then
If currentCombo = vbNullString Then
vertialCombinations arr, target, CStr(arr(i)), target - arr(i), i, vprice, verticalDict, tolerance
Else
vertialCombinations arr, target, currentCombo & "+" & CStr(arr(i)), remainingTarget - arr(i), i, vprice, verticalDict, tolerance
End If
usedValues.Add CStr(arr(i)), True
End If
Next i
End If
End Sub
Private Function readColToArray(ByRef ws As Worksheet, ByRef numCol As Long) As Variant
Dim numRows As Long
numRows = ws.Cells(ws.Rows.count, numCol).End(xlUp).row
If numRows < 4 Then
Exit Function
End If
Dim arr() As Double
ReDim arr(1 To numRows - 3)
Dim i As Long
For i = 4 To numRows
arr(i - 3) = ws.Cells(i, numCol).Value
Next i
readColToArray = arr
End Function
Private Function isUnfit(ByRef arr As Variant) As Boolean
Dim i As Long
On Error Resume Next
For i = LBound(arr) To UBound(arr)
If IsEmpty(arr(i)) Or arr(i) <= 0 Then
isUnfit = True
Exit Function
End If
Next i
isUnfit = False
On Error GoTo 0
End Function
Private Function calcPrice(ByVal result As String, ByRef factor() As Double, ByRef price() As Double) As Double
Dim parts() As String
Dim i As Long
Dim totalPrice As Double
Dim count As Long
parts = Split(result, " + ")
totalPrice = 0
For i = 0 To UBound(parts)
count = 1
If InStr(parts(i), "*") > 0 Then
count = CInt(Split(parts(i), "*")(1))
parts(i) = Split(parts(i), "*")(0)
End If
Dim j As Long
For j = 1 To UBound(factor)
If parts(i) = CStr(factor(j)) Then
totalPrice = totalPrice + price(j) * count
Exit For
End If
Next j
Next i
calcPrice = totalPrice
End Function
Private Function findOptRow(ByRef arr As Variant, ByRef startRow As Long, ByRef numCol1 As Long, ByRef numCol2 As Long) As Long
Dim numRows As Long
numRows = UBound(arr, 1)
Dim minRowIndex As Long
Dim minValue As Double
Dim minValueCount As Long
minValue = 20
Dim i As Long
For i = startRow To numRows
If Not IsEmpty(arr(i, numCol1)) Then
If arr(i, numCol1) < minValue Then
minValue = arr(i, numCol1)
minRowIndex = i
minValueCount = 1
ElseIf arr(i, numCol1) = minValue Then
minValueCount = minValueCount + 1
End If
End If
Next i
If minValueCount > 1 Then
Dim minRowNumber As Long
Dim minColumnValue As Double
minRowNumber = minRowIndex
minColumnValue = arr(minRowIndex, numCol2)
For i = minRowIndex To numRows
If arr(i, numCol1) = minValue Then
If arr(i, numCol2) < minColumnValue Then
minRowNumber = i
minColumnValue = arr(i, numCol2)
End If
End If
Next i
findOptRow = minRowNumber
Else
findOptRow = minRowIndex
End If
End Function
Private Function findMinRowInCol(ByRef arr As Variant, ByRef startCol As Long, ByRef endCol As Long) As Long
Dim minRow As Long
Dim minValue As Long
Dim rowSum As Double
Dim i As Long
Dim j As Long
If IsArray(arr) Then
If UBound(arr, 2) >= endCol Then
minRow = 1
minValue = 0
For j = startCol To endCol
minValue = minValue + arr(1, j)
Next j
For i = 2 To UBound(arr, 1)
rowSum = 0
For j = startCol To endCol
rowSum = rowSum + arr(i, j)
Next j
If rowSum < minValue Then
minRow = i
minValue = rowSum
End If
Next i
End If
End If
findMinRowInCol = minRow
End Function
Private Function getColumnOffset(ByRef manholeType As Variant) As Long
Select Case manholeType
Case 2
getColumnOffset = 6
Case 3
getColumnOffset = 12
Case 4
getColumnOffset = 18
Case 5
getColumnOffset = 24
Case 6
getColumnOffset = 30
Case Else
getColumnOffset = 0
End Select
End Function
Private Sub readDataFromWorksheet(ByRef ws As Worksheet, ByRef lower() As Double, ByRef lprice() As Double, ByRef upper() As Double, ByRef uprice() As Double, ByRef vertical() As Double, ByRef vprice() As Double, ByRef columnOffset As Long)
lower = readColToArray(ws, ws.Cells(1, 1 + columnOffset).EntireColumn.Column)
lprice = readColToArray(ws, ws.Cells(1, 2 + columnOffset).EntireColumn.Column)
upper = readColToArray(ws, ws.Cells(1, 3 + columnOffset).EntireColumn.Column)
uprice = readColToArray(ws, ws.Cells(1, 4 + columnOffset).EntireColumn.Column)
vertical = readColToArray(ws, ws.Cells(1, 5 + columnOffset).EntireColumn.Column)
vprice = readColToArray(ws, ws.Cells(1, 6 + columnOffset).EntireColumn.Column)
End Sub
Private Sub genTableTitle(ByRef lower() As Double, ByRef upper() As Double, ByRef vertical() As Double, ByRef tableTitle() As Variant, ByRef colIndex As Long)
Dim i As Long
Dim j As Long
ReDim tableTitle(1 To 2, 1 To UBound(lower) + UBound(upper) + UBound(vertical) + 7)
For i = 1 To 2
For colIndex = LBound(lower) To UBound(lower)
tableTitle(1, colIndex) = "L"
tableTitle(2, colIndex) = lower(colIndex)
Next colIndex
colIndex = UBound(lower) + 1
For j = LBound(upper) To UBound(upper)
tableTitle(1, colIndex) = "U"
tableTitle(2, colIndex) = upper(j)
colIndex = colIndex + 1
Next j
'colIndex = colIndex
For j = LBound(vertical) To UBound(vertical)
tableTitle(1, colIndex) = "V"
tableTitle(2, colIndex) = vertical(j)
colIndex = colIndex + 1
Next j
Next i
tableTitle(2, colIndex) = "vprice"
tableTitle(2, colIndex + 1) = "uprice"
tableTitle(2, colIndex + 2) = "lprice"
tableTitle(2, colIndex + 3) = "totalprice"
tableTitle(2, colIndex + 4) = "piece"
tableTitle(2, colIndex + 5) = "H"
tableTitle(2, colIndex + 6) = "deltaH"
End Sub
Private Sub lowupCombinations(ByRef Dict As Object, ByRef subkey As Long, ByRef arr() As Double, ByRef priceArr() As Double, ByRef outterArr As Variant, ByRef numCol As Long, ByRef colIndex As Long)
Dim rowIndex As Long
Dim key As Variant
Dim i As Long
rowIndex = 1
For Each key In Dict.Keys
For i = LBound(arr) To UBound(arr)
If Dict(key)(subkey) = CStr(arr(i)) Then
outterArr(rowIndex, numCol + i) = 1
Exit For
End If
Next i
outterArr(rowIndex, colIndex) = calcPrice(Dict(key)(subkey), arr, priceArr)
rowIndex = rowIndex + 1
Next key
End Sub
Private Sub genInfo(ByRef outterArr As Variant, ByRef tableTitle As Variant, ByRef numRows As Long, ByRef numCols As Long, ByRef height As Double)
Dim rowSum As Double
Dim H As Double
Dim deltaH As Double
Dim i As Long
Dim j As Long
For i = 1 To numRows
If Not IsEmpty(outterArr(i, numCols - 6)) Then
' totalprice 계산
rowSum = 0
For j = numCols - 6 To numCols - 4
rowSum = rowSum + outterArr(i, j)
Next j
outterArr(i, numCols - 3) = rowSum
' piece/H/deltaH 계산
rowSum = 0
H = 0
For j = 1 To numCols - 7
rowSum = rowSum + outterArr(i, j)
H = H + outterArr(i, j) * tableTitle(2, j)
Next j
deltaH = Round(height - H, 2)
outterArr(i, numCols - 2) = rowSum
outterArr(i, numCols - 1) = H
outterArr(i, numCols) = deltaH
End If
Next i
End Sub
Private Sub processTargetKey(ByRef targetDict As Object, ByRef tkey As Variant, ByRef lower() As Double, ByRef upper() As Double, ByRef vertical() As Double, ByRef vprice() As Double, ByRef outterArr As Variant, ByRef numCols As Long, ByRef tolerance As Double, ByRef verticalDict As Object)
Dim rowIndex As Long
Dim key As Variant
Dim i As Long
Dim j As Long
Dim colIndex As Long
If targetDict(tkey) > 0 Then
vertialCombinations vertical, targetDict(tkey), vbNullString, targetDict(tkey), LBound(vertical), vprice, verticalDict, tolerance
Dim numRowsVertical As Long
Dim numColsVertical As Long
numRowsVertical = verticalDict.count
numColsVertical = UBound(vertical) + 1
Dim dataArr() As Variant
If numRowsVertical <> 0 Then
ReDim dataArr(1 To numRowsVertical, 1 To numColsVertical)
rowIndex = 1
For Each key In verticalDict.Keys
Dim parts() As String
parts = Split(verticalDict(key), "+")
colIndex = 2
For i = LBound(parts) To UBound(parts)
Dim subParts() As String
subParts = Split(parts(i), "*")
For j = 1 To UBound(vertical)
If Trim$(subParts(0)) = CStr(vertical(j)) Then
dataArr(rowIndex, j) = Trim$(subParts(1))
Exit For
End If
Next j
colIndex = colIndex + 1
Next i
dataArr(rowIndex, numColsVertical) = calcPrice(verticalDict(key), vertical, vprice)
rowIndex = rowIndex + 1
Next key
Dim minRow As Long
If UBound(dataArr, 1) = 1 Then
minRow = 1
Else
'minRow = findMinRowInCol(dataArr, numColsVertical - 1, numColsVertical - 1)
minRow = findMinRowInCol(dataArr, 1, numColsVertical - 1)
End If
' vertical 계산값 중 vprice가 최소인 값만 취함
For i = 1 To numColsVertical
outterArr(tkey + 1, UBound(lower) + UBound(upper) + i) = dataArr(minRow, i)
Next i
End If
verticalDict.RemoveAll
ElseIf targetDict(tkey) = 0 Then
outterArr(tkey + 1, numCols - 6) = 0
End If
End Sub
Private Function withinTolerance(ByRef a As Double, ByRef b As Double, ByRef tolerance As Double) As Boolean
withinTolerance = Abs(a - b) <= tolerance
End Function
