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...
예제 데이터와 코드가 있는 파일입니다.
here sample data and vba code...
'기 타' 카테고리의 다른 글
vba 를 사용해서 mdb 생성에 필요한 데이터형식 인수 (0) | 2015.01.06 |
---|---|
한반도에 퍼지는 역행침식 현상 (1) | 2011.02.03 |
2010-08/17 방송예정이던 PD수첩 보도자료 전문 (0) | 2010.08.18 |
lrc파일 시간 편집기 (가사파일 시간 조정) (5) | 2009.03.11 |
버철박스 VirtualBox 에서 인터넷 Internet 이 안되면 (3) | 2008.12.11 |
법에 의한 또는 변호사 선임시 일반적인 절차 (0) | 2008.06.23 |