문제...

작업을 하기 위하여서는 다양한 협력업체와 자재의 분배를 하기 위한 작업을 요한다
작업이라는 것이 실은 필요에 따라 분배하고 통합하고,
필요에 따라, 통합하고 분배하고의 반복인셈이다
총도룹내역을 작업계획에 따라서 업체별로 분리내역서를 다시 만들어야
공사관리가 되는 것은 상식이다
이 작업을 아마도 삽질을 하게 될 것이다
복사,붙여넣고, 복사,붙여넣고, 수식을 이렇게 저렇게 엮어서
값을 가져오고..정신없는 일이다
그래로 다행스럽게 엑셀이라는 것이 있어서 이런 삽질도 하지..
아주 오래전 엑셀이 없던때는 그야말로 개고생이였다
이 고생스러운 작업을 간단하게 하기 위하여 VBA가 있는 것..
방법은 여러가지가 있겠지만..
같이 학습해가면서 무언가 만들어 보도록 하자
발주하는 곳마다 도급서류의 양식은 제멋대로다..
쓸데없이 서식을 온통하기고하고, 병합을 해버리기도 하고
기준이 없이 전부 제잘난맛에 엑셀을 사용한다



이런 도급서류로 공사관리를 위한 나름대로의 형식에 다시 정리 하여야 할것이다

아무튼..원본도급테이블을 복사하여 어느 정도 자사의 표준화된 테이블로 재구성하고



각 작업내용을 협력사별로 분배를 하기 위한 도구를 준비해 보자
협력회사목록테이블의 각회사별로
각각의 작업내용에 따라서, A사,B사,C사 등구분을 해주는 작업이 필요하다고 한다
그렇다면 어떻게 하면 쉽게 할수 있을까??

단축메뉴의 활용,입력도구...

다른 방법도 많겠지만, 여기에서는 각협력회사 표시를 해줄 열의 셀을
오른쪽 마우스의 크릭할때 Cell메뉴에 협력사 목록을 담아주고 선택함에 따라서
해당 셀에 입력이 되게 하면 편리할 것이다

협력업체 목록시트에 테이블을 준비하고 협력업체목록을 만들고
아래의 그림과 같이 각작업별로 협력업체별로 분배하는 작업을 할수 있는 단축메뉴를 만든다



여러작업에 한꺼번에 넣을수 있게 여러개의 범위를 선택해도 모두 한번에 입력되게 한다
그리고 실제작업이 아닌 행의 셀이 같이 선택이 되었을때는 실제작업인지
아닌지 확인하여 실제작업에만 입력하게 제어한다
지급자채구분을 위한 입력도 마찬가지요령으로 한다

''일반모듈시트에 자원이 되는 상수들을 정리하는 습관이 좋고
Public Const MAIN_SHT As String = "내역서"
Public Const MAIN_SUB_CON As String = "협력사구분"
Public Const MAIN_MTRL As String = "지급자재구분"
Public Const MAIN_TTL As String = "합계"
Public Const SUB_CONS_SHT As String = "협력사목록"

''아래는 지급자재이던, 협력사입력이던 메뉴버튼을 크릭하면 실행되는 프로시져
Sub putValue()
Dim rTarget As Range
Dim rX As Range
Dim sValue As String
Dim rTotalCol As Range

On Error Resume Next
Set rTarget = Selection
sValue = CommandBars.ActionControl.Caption
'' 병합행포함, 2개의 행에서 합계열확인
Set rTotalCol = rTarget.Worksheet.Rows(1).Resize(2).Find(MAIN_TTL, , , xlWhole) 
If rTotalCol Is Nothing Then
    MsgBox "열머리에 [" & MAIN_TTL & "]열제목이 있어야 합니다": Exit Sub
End If
For Each rX In rTarget.Cells
    If Intersect(rTotalCol.EntireColumn, rX.EntireRow).Value = "" Then
        '' 실제작업명이 아닌 것은 제외..
    Else
        rX = sValue
    End If
Next
End Sub

'' 메뉴만들기는 해당워크시트의 오른쪽마우스버튼의 단축메뉴를 활용한다
'' ThisWorkBook 개체의 크래스모듈상의 Workbook_SheetBeforeRightClick 이벤트프로시져를 활용한다
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

If Sh.Name <> modMain.MAIN_SHT Then GoTo X

On Error Resume Next
Dim oX As CommandBarControl
Dim oBtn As CommandBarButton
Dim rSubConList As Range
Dim rRow As Range

For Each oX In Application.CommandBars("Cell").Controls
    oX.Delete
Next


Select Case Target.EntireColumn.Cells(1)
    Case modMain.MAIN_SUB_CON
        Set rSubConList = Worksheets(modMain.SUB_CONS_SHT).Range("A1").CurrentRegion
        Set rSubConList = rSubConList.Offset(1).Resize(rSubConList.Rows.Count - 1)
        For Each rRow In rSubConList.Rows
            Set oBtn = Application.CommandBars("Cell").Controls.Add(Office.msoControlButton)
            oBtn.Caption = rRow.Cells(1)
            oBtn.OnAction = "putValue"
        Next
    Case modMain.MAIN_MTRL
        Set oBtn = Application.CommandBars("Cell").Controls.Add(Office.msoControlButton)
        oBtn.Caption = "지급자재"
        oBtn.OnAction = "putValue"
        Set oBtn = Application.CommandBars("Cell").Controls.Add(Office.msoControlButton)
        oBtn.Caption = ""
        oBtn.OnAction = "putValue"
    Case Else
        GoTo X
End Select
    
Exit Sub

X:
Application.CommandBars("Cell").Reset
End Sub

협력업체별 내역서 출력/UserForm으로 인터페이스만들기

내역서에 협력업체별로 작업을 분배표시를 하였으니..
어떤 특정협력업체의 내역서를 별도로 뽑아내는 것은 일도 아닐 것이다
아래와 같이 UserForm을 하나 삽입하고



폼 개체의 크래스모듈내에 아래와 같이 작성한다

''버튼을 프로그래밍적으로 Run-Time에 생성하여도 해당 콘트롤의 변수를 WithEvents키워드로 선언하면
Dim WithEvents oBtn As MSForms.CommandButton
''아래와 같이 이벤트프로시져를 쉽게 사용할수 있다
Private Sub oBtn_Click()
MsgBox "다음 화일에서.."
End Sub
''UserForm이 로딩되면서 발생하는 Initialize 이벤트프로시져에 필요한 콘트롤을 만든다
''프로그래밍적으로 콘트롤을 생성하는 것이 융통성이 있고
''컨트롤의 위치등을 좀더 정확하게 설정할수 있다
Private Sub UserForm_Initialize()
Dim rSubCons As Range
Dim rX As Range

On Error Resume Next

'' 목록상자 ////////////////////////////
Dim oListBox As MSForms.ListBox
Set oListBox = Me.Controls.Add("Forms.ListBox.1", "lstSubCon")
Set rSubCons = Worksheets(modMain.SUB_CONS_SHT).Range("A1").CurrentRegion.Offset(1).Columns(1)
Set rSubCons = rSubCons.Resize(rSubCons.Rows.Count - 1)
oListBox.Left = 6
oListBox.Top = 6
oListBox.Width = 100
oListBox.Height = 150
oListBox.MultiSelect = fmMultiSelectMulti ' fmMultiSelectExtended
oListBox.List = Application.WorksheetFunction.Transpose(rSubCons)

'' 그룹상자와 옵션버튼 2개///////////////

Dim oGroup As MSForms.Frame
Set oGroup = Me.Controls.Add("Forms.Frame.1", "grpOptions")
oGroup.Caption = "출력방법"
oGroup.Left = oListBox.Left + oListBox.Width + 6
oGroup.Top = oListBox.TopIndex
oGroup.Width = 100
oGroup.Height = 35
Dim oOpt As MSForms.OptionButton
Set oOpt = oGroup.Controls.Add("Forms.OptionButton.1", "optSheet")
oOpt.Top = 6
oOpt.Left = 6
oOpt.Caption = "시트"
oOpt.Value = True

Set oOpt = oGroup.Controls.Add("Forms.OptionButton.1", "optBook")
oOpt.Top = 6
oOpt.Left = 40
oOpt.Caption = "통합문서"

'' 명령버튼..//////////////////
Set oBtn = Me.Controls.Add("Forms.CommandButton.1", "btnMake")
oBtn.Top = oGroup.Top + oGroup.Height + 6
oBtn.Left = oGroup.Left
oBtn.Caption = "만들기"
oBtn.Width = 100
oBtn.Height = 22


setControls
Me.Height = oListBox.Height + 50
Me.Width = oGroup.Left + oGroup.Width + 10
Me.Caption = "내역서 협력업체별로 만들기도구"
End Sub

Sub setControls()
On Error Resume Next
Dim oCtl As Control
For Each oCtl In Me.Controls
    oCtl.Font.Name = "맑은 고딕"
    oCtl.Font.Size = 9
Next
End Sub

위와 같이 하면 아래와 같이 컨트롤들이 만들어지게 된다



UserForm을 실행시키는 메뉴는
위에서 만든 단축메뉴에 추가 시켜 놓았다
실행시켜 보면서 다른 소루션에서도 많은 응용을 하셔 보시는 것이 좋겠다

협력업체별 내역서 출력

UserForm의 버튼을 크릭하면
목록상자에 선택된 협력업체별 별도의 시트를 만들도록 하면 되겠다
이런 작업을 할때는 하나의 시트를 만드는 프로시져를 먼저 준비하는 것이 좋을 것이다
아래와 같이

''프로시져의 매개변수는
''sSubCon=협력회사명
''rTbl=전체테이블범위
''sWhere=현재의 통합문서상에 별도의 시트로 만들 것인지, 아니면 통합문서에 만들고 저장할것인지
Sub writeSheet(sSubCon As String, rTbl As Range, sWhere As String)
On Error Resume Next

'' 이미 만들어진 시트있으면 무조건 삭제..
Application.DisplayAlerts = False
Worksheets(sSubCon).Delete
Application.DisplayAlerts = True

Dim oBook As Workbook
Dim shtX As Worksheet
Dim rRow As Range
Dim rRow_ As Range
Dim rCurrentBlock As Range
Dim rColToCheck As Range
Dim oRows As Collection
Dim rCateLabel1 As Range
Dim rCateLabel2 As Range
Dim iLastCol As Integer
Dim iRow As Integer

iLastCol = rTbl.Columns.Count
Set rColToCheck = rTbl.Columns(iLastCol).SpecialCells(xlCellTypeConstants)

Set shtX = Worksheets.Add
shtX.Name = sSubCon

'' 시트 머리행복사,붙이기////////////////
rTbl.Rows(1).Offset(-2).Resize(2).Copy shtX.Rows(1).Cells(1)
''작업의 효율을 높이기 위하여 ...ScreenUpdating=False
Application.ScreenUpdating = False
iRow = 2
For Each rCurrentBlock In rColToCheck.Areas
    Set oRows = New Collection
    For Each rRow In Intersect(rTbl, rCurrentBlock.EntireRow).Rows
        If rRow.Cells(iLastCol) = sSubCon Then
            oRows.Add rRow
        End If
    Next
    '' 해당분류작업명에 조건에 맞는 작업이 들어 있으면
    '' 해당분류작업명을 복사하여 붙인다
    If oRows.Count > 0 Then
        Set rCateLabel1 = rCurrentBlock.Cells(1).Offset(-1)
        Set rCateLabel2 = rCurrentBlock.Cells(1).End(xlUp).Offset(1)
        Set rCateLabel1 = Intersect(rTbl, rTbl.Worksheet.Range(rCateLabel1, rCateLabel2).EntireRow)
        iRow = iRow + 1
        rCateLabel1.Copy shtX.Rows(iRow).Cells(1)
        iRow = iRow + rCateLabel1.Rows.Count - 1
        For Each rRow_ In oRows
            iRow = iRow + 1
            rRow_.Copy shtX.Rows(iRow).Cells(1)
        Next
    End If
Next
shtX.UsedRange.Columns.AutoFit

'' 별도의 통합문서별로 만들고 싶을때../////////
If sWhere = "book" Then
    If Dir(ThisWorkbook.Path & "\" & modMain.FILE_FOLDER) = "" Then
        VBA.MkDir ThisWorkbook.Path & "\" & modMain.FILE_FOLDER
    End If
    ''통합문서의 저장, 시트의 삭제등에서 메시지박스보이지 않게
    Application.DisplayAlerts = False
    shtX.Copy
    Set oBook = ActiveWorkbook
    oBook.Close True, ThisWorkbook.Path & "\" & modMain.FILE_FOLDER & "\" & sSubCon & ".xls"
    shtX.Delete
    Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub

이제 목록상자에 사용자가 선택한 내용을 순환하면서
위의 프로시져를 호출하면 된다
아래와 같이 [만들기]버튼을 크릭하면...

Private Sub oBtn_Click()
Dim oListBox As MSForms.ListBox
Dim iX As Integer
Dim sSub As String
Dim sSubs As String
Dim rX As Range
Dim rTargetCol As Range
Dim rTbl As Range

'' [협력사구분] 열 찾아서, 유효한 작업대상테이블범위를 찾는다(테이블의 열머리행은 제외)
For Each rX In ActiveSheet.UsedRange.Rows(1).Cells
    If rX = modMain.MAIN_SUB_CON Then
        Set rTargetCol = Intersect(rX.EntireColumn, ActiveSheet.UsedRange)
        Set rTargetCol = rTargetCol.Offset(2).Resize(rTargetCol.Rows.Count - 2)
        Set rTbl = Range(rTargetCol, rTargetCol.End(xlToLeft))
        Exit For
    End If
Next
'' 목록상자의 목록아이템을 하나,하나 순환하면서..
Set oListBox = Me.Controls("lstSubCon")
For iX = 0 To oListBox.ListCount - 1
''Selected(목록인덱스)는 선택이 되었을때는 True,아닐때는 False이다
    If oListBox.Selected(iX) Then
        sSub = oListBox.List(iX)
''아래는 writeSheet Sub,rTbl,Iif(Me.Controls("optSheet").Value,"sheet","book")
''과 같이 간단하게 처리하는 것도 좋을 것이다	
        If Me.Controls("optSheet").Value Then
''시트에 만들때		
            writeSheet sSub, rTbl, "sheet"
        Else
''통합문서에 만들때		
            writeSheet sSub, rTbl, "book"
        End If
        sSubs = sSubs & sSub & vbNewLine
    End If
Next
If sSubs = "" Then
    MsgBox "목록상자에서 선택하시고 하세요"
Else
    MsgBox IIf(Me.Controls("optSheet").Value = True, _
                "", "별도의 문서에" & vbNewLine) & "아래 내용을 만들었습니다" & vbNewLine & sSubs
    Unload Me
End If
End Sub