아주 재미난 로직을 소개합니다

현재값을 바탕으로 미래를 예측하는 시나리오에 적합한 로직입니다

피벗테이블을 사용한
지역별, 부서별 합을 구하는 방법은  아주 훌륭한 기능인데요

부서별 인원을 구한 이후에 
만들어진 결과를 가지고 특정 부서의 인원을 늘리고자 한다면
그리고 그 이후의 총 인원 변화를 예상하려 한다면

피벗의 경우는 원본 데이터의 일부를 수정 한 다음 피벗 갱신 을 해야합니다
어디를 수정할지 그리고 갱신은 언제 누를 지 답답합니다

해서...
결과물을 피벗과 같은 형태로 만들되  ,  부분합 부분만 수식을 만든 다음
특정 부서의 인원(부분합 부분이 아니겠습니다)을 변경할 때 총 인원이 자동으로 늘어나는

그런 로직입니다.

로직의 요약은 이렇습니다
실제 데이터 원본이 존재합니다.
조건별로 부분합이 있는 집계를 구합니다.

만들어진 결과는 일테면 지역별 성별 인원수 인 경우는
지역별 소계(부분합)는 존재합니다 ----------------------------- 수식
지역의 성별 인원은 피벗 처럼 값으로 결과를 만들어냅니다 ---------- 값

만들어진 결과 중에서 부분합 부분은 수식이어야 하고
"값" 부분을 변경하면 "수식" 부분이 자동 계산되어 전체의 값 변동을 즉시 알수 있도록 함이 목적입니다.
데이터 원본은 건드리지 않고 특정 부서의 인원을 바꾸면 전체 인원이 얼마나 되나
를 볼수 있는 로직입니다.   기대치 확보나, 시뮬레이션 가동에 유용합니다.

0123456789


주요 코드입니다


Option Explicit




Sub Excute_Expect()' === 모듈 시작
' CodeBy [ 오즈맨 ] , Date : 2015-04-19

Dim MyySheet   As Worksheet

Set MyySheet = ThisWorkbook.Sheets("DATA")

Call Range_Clear

MsgBox "Ready~~"

Call PivotSumUP(RngSource:=MyySheet.Range("$C$5").CurrentRegion, AnswerRng:=MyySheet.Range("P5"), SubTotal_At_Top:=False)

Call PivotSumUP(RngSource:=MyySheet.Range("$C$5").CurrentRegion, AnswerRng:=MyySheet.Range("AC5"), SubTotal_At_Top:=True)

End Sub         ' ___ 모듈 종료


Sub PivotSumUP(RngSource As Range, AnswerRng As Range, SubTotal_At_Top As Boolean)' === 모듈 시작
' CodeBy [ 오즈맨 ] , Date : 2015-04-19
Dim ii    As Double
Dim jj    As Double
Dim Work_Sheet      As Worksheet
Dim Sort_Sheet      As Worksheet
Dim Uniq_Count      As Double
Dim Rows_Count      As Double           ' 원본의 ROWS
Dim Found__Row      As Double           ' 찾는 INDEX NUMBER
Dim Found_Colm      As Double

Dim MySource        As Variant          ' 피벗의 원본

Dim Uniq_Value      As New Collection   ' ANSW 용 UNIQ , Fixed 문자열
Dim FixedValue      As Variant
Dim Sort_Value      As Variant          ' 쏘트용 값    INSERT -> Uniq_Value

Dim EditRange  As Range
Dim FixString  As String
Dim tmpString  As String      ' UNIQ 만들때 사용하는 임시변수
Dim MyAnswers  As Variant     ' 최종 결과
Dim tmp_Array  As Variant     ' SORT 이후를 ANSW 로 보낼 임시변수

Dim Sort_Range As Range

Dim Has_Gross_Total As Boolean
Dim Top_Gross_Total As Boolean


     Has_Gross_Total = True
     Top_Gross_Total = False ' True
     

Dim Gross_total_Top  As String



FixString = "_|_"


Application.ScreenUpdating = False

Set Work_Sheet = RngSource.Parent
Set Sort_Sheet = Sheets("sheet3") ' Worksheets.Add
'''Work_Sheet.Activate



     MySource = RngSource.Value
     Rows_Count = UBound(MySource, 1)
     
On Error Resume Next
ReDim FixedValue(1 To Rows_Count) As Variant
ii = 1
     For jj = 2 To 4
          tmpString = tmpString & FixString & MySource(ii, jj)
     Next
          FixedValue(ii) = tmpString
          Uniq_Value.Add tmpString, tmpString

For ii = 2 To Rows_Count
     tmpString = ""
     For jj = 2 To 4
          tmpString = tmpString & FixString & MySource(ii, jj)
          Uniq_Value.Add tmpString, tmpString
     Next
          FixedValue(ii) = tmpString
Next

Uniq_Count = Uniq_Value.Count
ReDim Sort_Value(1 To Uniq_Count, 1 To 2)
For ii = 1 To Uniq_Count
     Sort_Value(ii, 1) = Uniq_Value(ii)
     Sort_Value(ii, 2) = Uniq_Value(ii) & "Z"
Next


Set Sort_Range = Sort_Sheet.Range("A1")
Sort_Range.Resize(Uniq_Count, 2).EntireColumn.ClearContents
Sort_Range.Resize(Uniq_Count, 2) = Sort_Value

     If Has_Gross_Total = True Then
          If Top_Gross_Total = True Then
               Gross_total_Top = "Top"
          Else
               Gross_total_Top = "Bottom"
          End If
     
     ElseIf Has_Gross_Total = False Then
               Gross_total_Top = "No"
     End If



If Gross_total_Top = "Top" Then
          Sort_Range.Offset(Uniq_Count, 0).Resize(1, 2) = "'"
          Uniq_Count = Uniq_Count + 1
End If

If SubTotal_At_Top = True Then
          Sort_Range.Resize(Uniq_Count, 2).SortSpecial key1:=Sort_Range(1, 1), Order1:=xlAscending, Header:=xlYes
Else
          Sort_Range.Resize(Uniq_Count, 2).SortSpecial key1:=Sort_Range(1, 2), Order1:=xlAscending, Header:=xlYes
End If


If Gross_total_Top = "Bottom" Then
          Sort_Range.Offset(Uniq_Count, 0).Resize(1, 2) = "'"
          Uniq_Count = Uniq_Count + 1
End If


Sort_Value = Sort_Range.Resize(Uniq_Count, 1).Value

ReDim MyAnswers(1 To Uniq_Count, 1 To 5)

Set Uniq_Value = Nothing

For ii = 1 To Uniq_Count
     Uniq_Value.Add ii, Sort_Value(ii, 1)
Next
     Uniq_Value.Add ii, ""

For ii = 1 To Uniq_Count
     Found_Colm = InStrRev(Sort_Value(ii, 1), FixString) - 1
     If Found_Colm >= 0 Then
     
     tmpString = Left(Sort_Value(ii, 1), Found_Colm)
     Found__Row = Uniq_Value(tmpString)
          ' 누적
          MyAnswers(Found__Row, 4) = MyAnswers(Found__Row, 4) & "+R[" & ii - Found__Row & "]C"
          MyAnswers(Found__Row, 5) = MyAnswers(Found__Row, 5) & "+R[" & ii - Found__Row & "]C"
     
     End If

     
     tmp_Array = Split(Sort_Value(ii, 1), FixString)
     For jj = 1 To 3
          MyAnswers(ii, jj) = tmp_Array(jj)
     Next
Next


For ii = 2 To Rows_Count
     Found__Row = Uniq_Value(FixedValue(ii))
     ' 인원수
     MyAnswers(Found__Row, 4) = MyAnswers(Found__Row, 4) + 1
     ' 인건비
     MyAnswers(Found__Row, 5) = MyAnswers(Found__Row, 5) + MySource(ii, 5)
Next


For ii = 2 To Uniq_Count
     If Left(MyAnswers(ii, 4), 1) = "+" Then
          MyAnswers(ii, 4) = "=" & Mid(MyAnswers(ii, 4), 2)
          MyAnswers(ii, 5) = "=" & Mid(MyAnswers(ii, 5), 2)
     End If
Next

For ii = Uniq_Count To 2 Step -1
     For jj = 1 To 3
          If MyAnswers(ii, jj) = MyAnswers(ii - 1, jj) Then
          MyAnswers(ii, jj) = Empty
          End If
     Next
Next

If Gross_total_Top = "Top" Then
     MyAnswers(2, 1) = "총계"
ElseIf Gross_total_Top = "Bottom" Then
     MyAnswers(Uniq_Count, 1) = "총계"
Else
End If

MyAnswers(1, 4) = "인원"
MyAnswers(1, 5) = "인건비"

With AnswerRng.Resize(Uniq_Count, 5)
     .EntireColumn.ClearContents
     .EntireColumn.Interior.ColorIndex = xlNone
     
     .Formula = MyAnswers
     .Interior.ColorIndex = 15
     .NumberFormat = "#,#"
End With

Set EditRange = AnswerRng(1, 4).Resize(Uniq_Count, 2).SpecialCells(xlCellTypeConstants, xlNumbers)
EditRange.Interior.ColorIndex = xlNone

Application.ScreenUpdating = True

Application.DisplayAlerts = False
Application.DisplayAlerts = True


End Sub         ' ___ 모듈 종료


플래시 파일이 잘 안 보이면 그냥 다운로드 하세요

If cannot flash file... download movie...

PivotFormula4Simm.exe


예제 데이터와 코드가 있는 파일입니다.

here sample data and vba code...

PivotFormulaNew.xls





Posted by 오즈맨스머프


여러분에게 규격화된 데이터가 있으믄

집계(개수 구하기 합계 구하기...)가 무진장 쉬워요


게다가 수식??? 함수???도 쓸 필요가 없어요

따라해보아요



요거는 따운로드
Posted by 오즈맨스머프