Excel) 조립식 맨홀 구체 최적 조합

프로그램 설명

설계자가 원하는 맨홀규격(타입) 및 높이에 따라 조립식 PC맨홀 하부구체, 상부구체, 연직구체의 최적 조합을 찾는 VBA 매크로 입니다. 아무쪼록 없는 실력으로 어렵게 만들었고 원하는 처리 속도보다 빠르지 않지만 필요한 분들께 도움 됬으면 좋겠습니다.

제가 설정한 최적 조합의 기준은 계획맨홀 높이에 부합하는 하부구체, 상부구체, 연직구체의 조합을 모두 구한 후 구체수가 가장 적은 조합을 선택하며(구체수가 많으면 설치비가 증가하므로), 가장 적은 조합 중 구체수가 동일한 조합이 있을 경우 조합된 각 구체의 총 자재가격을 비교해 가장 낮은 가격의 조합을 선택하는 것 입니다.

자세한 내용은 아래 설명 및 동영상(자막, 목소리 없음) 참조

엑셀 Sheet설명

<dataSheet> 시트

VBA 코드 작동을 위한 기초 자료가 저장된 시트로 조립식 PC맨홀의 규격별 하부구체, 상부구체, 연직구체에 대한 치수(dim)와 자재 가격(price)을 입력하며 데이터 입력은 다음과 같이 이루어져야 합니다:

  1. 각각의 규격(예: 원형맨홀 1호, 2호...)에 대한 하부구체(lower), 상부구체(upper), 연직구체(vertical)의 치수(dim)와 가격(price)을 행 방향으로 기입합니다. 총 6개의 맨홀타입 입력 가능 (하부구체에는 관로가 연결되므로 연결 관로의 외경, 관로 삽입을 위한 구멍을 고려해 적용하고자 하는 하부구체의 높이를 입력합니다. 또한 유입, 유출관의 단차가 높은 경우 조립식 PC맨홀 사용이 불가하니 유념하시기 바랍니다.)
  2. 행 방향으로 데이터를 입력할 때, 빈 셀을 포함해서는 안 됩니다. 모든 치수와 가격 정보가 짝을 이뤄 순서대로 입력되어야 합니다.
  3. 기존에 작성된 데이터(물가자료 2023년 7월호 특정 회사 제품, 업체 정보는 삭제)를 원하는 제품의 치수와 가격 정보로 대체하면 됩니다. 예를 들어, 다른 회사의 제품 정보로 수정하거나, 원하는 제품의 규격에 따라 치수와 가격을 입력할 수 있습니다.

이렇게 데이터를 입력하고 실행하면, 입력한 제품의 정보를 기반으로 VBA 매크로가 최적의 조합을 찾게 됩니다.

<개별체크>시트

맨홀 1개에 대해 맨홀의 타입과 높이를 설정하여조립식 PC 맨홀의 하부구체, 상부구체, 연직구체 조합을 확인하고 최적 조합을 검토할 수 있습니다. 조합 결과는 다음과 같이 작동합니다:

  1. 하부구체(L)와 상부구체(U)의 모든 조합을 구합니다. 이때, 계획한 맨홀 높이와 일치하는 조합이 있으면 연직구체(V)는 필요 없으므로 연직구체의 수량(V)은 비워두고, 연직구체의 가격(vprice)은 0으로 설정됩니다.
  2. 하부구체(L)와 상부구체(U)의 모든 조합을 구한 후 연직구체(V)와의 조합을 내부적으로 수행하고, 조합되는 결과가 있을 경우 최적 조합을 선택해 최적 조합만 연직구체 수량(V) 및 연직구체 가격(vprice)을 표시합니다.(연직구체의 조합은 경우의 수가 너무 많아 모든 내부 수행 결과는 따로 표시하지 않고 최적 조합만 출력합니다.)
  3. 계산 결과에서 연직구체의 가격(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가 빈 셀인 경우는 허용오차내에서 조합이 되지 않은 경우로 허용오차값을 조정하거나 <개별체크>시트를 참고해 사용자가 수작업으로 수정하시기 바랍니다.

사용시 유의사항

  1. 코드는 엑셀 2010에서 작성되었고, 해당 버전에서 정상적으로 작동합니다. (일반적으로 엑셀의 상위 버전에서도 호환성이 유지될 것입니다.)
  2. 코드를 사용함으로써 발생하는 오류나 문제에 대해서는 사용자 본인이 책임을 집니다.
  3. 또한 본 코드는 대규모 데이터 세트의 경우 실행 시간이 오래 걸리거나 오류가 발생할 수 있습니다.(dataSheet에 입력된 조립식 PC맨홀 구체의 갯수가 많은 경우, 계획맨홀 높이가 높을 경우, 일괄조회 할 맨홀의 수량이 많은 경우 등 조합할 경우의 수가 많을수록 시간이 오래 걸립니다.)
  4. 코드를 수정하고 출처를 표시하여 배포하는 것은 자유롭게 가능합니다. 그러나 상업적인 목적으로 이용하는 것은 허용되지 않습니다.
  5. 이상현상 발생시 댓글달아주세요.

다운로드

조립식pc맨홀구체최적조합.xlsm
Size: 87KB
Version: v1
Published: 2024-01-12

코드

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

Leave a Comment