- 어 부
- 조회 수 24007
- 댓글 수 339
- 추천 수 0
VBA 보조필살기 만들기 Project
단군 200일차를 시작하는 마음가짐
1. 중요한건 지금하는 단군의 후예 활동을 믿느냐 안 믿느냐다. 나는 믿는다. 나답게 살기 위해서 결과가 어떻든 밀어붙인다.
- 영화 머니볼, 자기답게 살고자 애쓰는 자들을 위해 축배를
2. 현실과 이상의 경계를 잘 걷는다. 그러기 위해서 성실해야 된다.
구직과 관련 된 모든 행위에서 성실해야 한다.
내가 정말 잘하고 좋아할 수 있는 일을 찾기 위해 하루를 되돌아보고, 나에 대해 정리한다. 그리고 생각을 매일 실천한다.
새벽시간과 새벽활동
기상시간: 5시 30분
활동시간 : 오전 6시 00분~ 오전 8시 00분(엑셀), 재활 : 오후 6시 ~ 오후 7시(집을 나설 일이 있을 때는 엑셀 활동 후)
새벽 활동 : 엑셀 공부(2시간), 어깨 재활 운동(1시간)
기상 시나리오: 5시 30분 기상, 요가 10분, 물 한잔 먹고, 스트레칭 하면서 컴퓨터 키기
전체적인 목표
엑셀 VBA 숙달, 어깨 재활
엑셀공부의 의미
1. 내가 잘하고 싶고, 재밌어 하는 것으로 하루를 시작
2. 단군 활동으로(나의 노력으로) 자신을 믿는 과정
3. 취업을 다른 사람들에게 의존하지 않고 내 힘으로 해처나가겠다는 의지
4. 다른 지원자들과의 차별점
재활운동의 의미
1. 건강에 대한 욕망 실현
2. 장기전을 위한 체력 비축
개인의식
1. 기상 후 3분 요가
가. 3분도 집중해서 요가하면 짧은 시간이 아님. 몰입도를 느낀다.
나. 단 3분으로 내가 좋아하는 것을 매일 하는 것에 대한 유익함(건강)과 성장(유연성)를 확인한다.
다. 삶에 쫓기지 않고, 내가 삶을 이끈다는 느낌을 받는다.
2. 귀가 후 버스에서 하루 되돌아보고 정리하기(나와의 대화)
가. 그 날 어떤 일이 있었고 내가 어떤 행동을 했고 왜 그런 행동을 했는지 생각하고 핸드폰 메모장에 적기.
중간 목표
1. 엑셀(직접 VBA를 짜보는 것을 원칙으로 한다.)
목표1: VBA 지식 넓히기, 익숙해지기
세부활동: 엑셀장인의 엑셀 매크로&VBA 마스터링 북 1회독. 매크로 기록해보면서 따라한다. 모르는건 카페에 들어가서 질문한다.
책만 무작정 보지 않고 http://www.uno21.com/에 들어가서 문제도 풀어보며 점검 한다.
목표기간: 9월 22일 ~ 11월 30일
목표2: 컴활 1급 취득
세부활동: 아이티고 강의이용해서 컴활 1급 시험 준비
목표기간
필기: 2014년 10월 18일(접수기간: 2014.09.25 ~ 2014.10.01)
실기: 2014년 11월 29일(접수기간: 2014.11.06 ~ 2014.11.12)
2. 어깨 재활 운동
목표1: 오른 쪽 어깨 회전 근 강화
세부활동: 밴드 운동, 바쁠 때는 코어운동과 오른쪽 어깨 밴드운동으로 대체.
목표기간: 9월 22일 ~ 11월 31일
목표 달성 과정에서 직면하게 될 난관과 극복 방안
1. 왜 아침에 일찍 일어나야 하는지 의문에 대한 대답
가. 저녁에는 각종 유혹(친구들과의 만남, TV, 인터넷 딴 짓)으로 하고자 하는 일을 놓칠 수 있음.
나. 엑셀, 재활은 꼭 하고 싶고 중요한 일이며, 이 일들을 매일 하기 위해서는 아침에 일찍 일어나서 하는 것이 확실 함.
다. 늦게 자면 늦게 일어나게 되고 하루의 시작이 순조롭지 못하지만 일찍 일어날 경우 하루의 시작을 좋게 함.
라. 현재 시간을 자유롭게 조절하기 가장 좋은 시기이므로 좋은 습관을 만들기에 적합.
마. 수련기간 중간에 취업을 하더라도 버스에서 노트북으로 엑셀 공부라도 할 수 있음.
바. 어쩔 수 없이 늦게 자서 일찍 일어나 피곤한 경우가 생긴 경우 하루 단위로 보면 손해이지만
길게 보았을 때는 이득임.(회사를 다니면서 계리 자격증을 딴 삼성화재 직원의 경우 전날 술자리가 있었어도
토, 일요일에 무조건 8시에 도서관을 갔다고 함, 피곤한 날도 있지만 자신과의 약속을 지킴으로 전체적으로
충실한 수험 공부를 가능케 함)
사. 밤에 집중이 잘 되는 스타일이지만 그것 또한 하나의 습관으로 자리 잡아서 그런 것, 아침에 집중하는 습관을
만들자, 단지 힘들고 좀 오래 걸릴 뿐이다.
2. 밤에 늦게 자는 습관
가. 집에 귀가 후 간단히 운동 후 바로 씻고 밥 먹는다.
나. TV 근처에 가지 않고, 컴퓨터를 밤에 켜지 않는다.
다. 스마트폰으로 구본형 선생님 글을 오래 읽지 않고, 책을 아예 빌려 본다.
라. 과거 밤에 하던 습관들을 요가, 책읽기로 대체 한다.
마. 일주일 단위 계획을 세운다 해야 할 일을 만들어 일찍 자야하는 이유를 분명히 한다.
하루를 개편하기 위해 하는 일임을 잊지 말자!
3. 왜 엑셀 공부와 재활운동을 해야하는가
가. 두 활동 모두 하고 싶은 일이고 성과가 뚜렷하게 나오기 때문에 지킬 확률이 높음.
나. 엑셀의 경우 어딜가도 쓰임, 특히 계리에서는 중요함. 취업에 있어서 급한 일은 아니지만 급한 일만 하다보면
정작 중요한 일을 항상 못함, 회사에서 알바 시 시킨 일만 하다보면 정작 내 실력을 늘리기 위한 시간을 못 낸
경우가 많았음, 엑셀만 잘 해도 업무 시간 단축과 일 잘한다는 소리 듣기 쉽다는걸 깨닳음 엑셀의 기능은 무궁무진함.
다. 재활 운동 또한 많은 시간을 집중해서 적어도 3달이상 투자해야 효과가 나옴, 그리고 어깨가 아프면 운동을 제대로
못하고 체력이 금방 약해짐, 나중에 회사생활을 위해서라도 꼭 필요함.
목표를 달성했을 때 내 삶에서 일어날 긍정적인 변화 묘사
1. 엑셀 관련
가. 회사에서 나만의 무기를 만들기 위한 하나의 강력한 tool 이 되어 줄 것임.
나. 엑셀을 잘 하는, 꾸준히 해온 내 모습에서 자신감을 얻을 수 있음. 빠른 잡무 처리 및 반복적인 업무를 재밌게 할 수 있음!
다. 단군의 후예 축소판으로 1000시간(1년 조금 넘게) 실행 후 노력에 대한 성과 확인 가능! 이로 단군의 후예 10000시간 법칙에
내가 정말 필살기로 만들고 싶은 걸 시작!
2. 재활 관련
가. 건강한 몸을 통해 긍정적인 마음, 자신감을 더 갖게 될 수 있음.
나. 꾸준한 건강관리를 위한 초석이 되어 줄 것임.
다. 좋아진 내 몸 보면 좋겠지.
3. 아침 기상 습관으로 하루 개편 성공 시 내가 원하는 삶을 사는 초석이 됨.
목표 달성 시 나에게 줄 보상
미루지 않고 여행을 떠난다. 한 3박 4일 정도 산, 바다가 있는 곳
Reconnect with why what I tried to do matters
Option Explicit
Sub 시트통합2()
Dim rFieldname As Range
Dim shtSummary As Worksheet
Dim MonthStart, MonthEnd, MonthCnt As Integer
Dim Datafieldnum As Integer
Dim i, j, iNum As Integer
Dim sht As Worksheet
Dim rRawdata, rRawdataHead, rRawdataBody As Range
Dim c As Range
Dim rPaste As Range
Dim sMonth As String
Dim oMonthes As New Collection
Dim rX As Range
Dim rCurrentCell As Range
MonthStart = 7
MonthEnd = 11
MonthCnt = MonthEnd - MonthStart + 1
Datafieldnum = 7
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Summary_report").Delete
On Error GoTo 0
Set shtSummary = Sheets.Add
shtSummary.Name = "Summary_report"
Set rFieldname = shtSummary.[a4]
With rFieldname
.Cells(2).Value = "Part Name"
.Cells(2, 2).Value = "구 분"
For i = 1 To MonthCnt
With .Cells(1, (Datafieldnum + 1) * i - 5)
.Value = MonthStart + i - 1 & "월"
.Resize(, Datafieldnum).Merge
oMonthes.Add .Resize(, Datafieldnum)
For j = 1 To Datafieldnum
.Cells(2, j).Value = j
Next
.Cells(1, j).Value = MonthStart + i - 1 & "월 요약"
.Cells(1, j).Resize(2).Merge
End With
Next
For Each sht In ThisWorkbook.Sheets
Set rPaste = .Cells(10000).End(xlUp).Offset(1)
If Len(sht.Name) = 1 Then
Set rRawdata = sht.Range("a10000").End(xlUp).CurrentRegion
Set rRawdataHead = rRawdata.Rows(2)
Set rRawdataBody = rRawdata.Resize(rRawdata.Rows.Count - 2).Offset(2)
rRawdataBody.Resize(, 2).Copy rPaste
For Each rX In rRawdataHead.Cells
If rX.Value >= 1 And rX.Value <= 12 Then
iNum = rX
sMonth = rX.Offset(-1).MergeArea.Cells(1)
Set rCurrentCell = getCurrentBlock(iNum, sMonth, oMonthes)
Set rCurrentCell = Intersect(rCurrentCell.EntireColumn, rPaste.MergeArea.EntireRow)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
'If MergeCells(rX) Then
' rCurrentCell.Cells(1).End(xlUp).End(xlToRight).Cells (2)
End If
Next
End If
Next
End With
End Sub
Function getCurrentBlock(iNum As Integer, sMon As String, oMonthes As Collection)
Dim rBlock As Range
Dim varX As Variant
Dim rX As Range
For Each varX In oMonthes
Set rBlock = varX
If rBlock.Cells(1).Value = sMon Then
For Each rX In rBlock.Cells(1).Offset(1).Resize(, rBlock.Cells.Count).Cells
If rX.Value = iNum Then
Set rBlock = rX
GoTo X
End If
Next
End If
Next
X:
Set getCurrentBlock = rX
End Function
Sub 선택하여붙여넣기()
Dim rOrgin As Range
Dim rDestin As Range
Set rOrgin = ThisWorkbook.Sheets("쌤플").[a1].CurrentRegion
Set rDestin = ThisWorkbook.Sheets("Sheet2").Range("a1")
rOrgin.Copy
rDestin.CurrentRegion.Clear ' 왜 이 코딩을 지나면 에러가 발생하는지 모르겠다.
With rDestin
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.DisplayAlerts = False
.PasteSpecial xlPasteColumnWidths
Application.DisplayAlerts = True
End With
End Sub
Sub copyAndPasteMergedRange()
Dim rOrigin As Range
Dim rDestin As Range
Set rOrigin = Worksheets("쌤플").Range("A1").CurrentRegion
rOrigin.Copy
Set rDestin = Worksheets.Add.Range("A1")
rDestin.PasteSpecial xlPasteValues
rDestin.PasteSpecial xlPasteFormats
Application.DisplayAlerts = False
rDestin.PasteSpecial xlPasteColumnWidths
Application.DisplayAlerts = True
End Sub
Option Explicit
Sub 시트통합2()
Dim rFieldname As Range
Dim shtSummary As Worksheet
Dim MonthStart, MonthEnd, MonthCnt As Integer
Dim Datafieldnum As Integer
Dim i, j, iNum As Integer
Dim sht As Worksheet
Dim rRawdata, rRawdataHead, rRawdataBody As Range
Dim c As Range
Dim rPaste As Range
Dim sMonth As String
Dim oMonthes As New Collection
Dim rX As Range
Dim rCurrentCell As Range
Dim rMonthSummary As Range
MonthStart = 7
MonthEnd = 11
MonthCnt = MonthEnd - MonthStart + 1
Datafieldnum = 7
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Summary_report").Delete
On Error GoTo 0
Set shtSummary = Sheets.Add
shtSummary.Name = "Summary_report"
Set rFieldname = shtSummary.[a4]
With rFieldname
.Cells(2).Value = "Part Name"
.Cells(2, 2).Value = "구 분"
For i = 1 To MonthCnt
With .Cells(1, (Datafieldnum + 1) * i - 5)
.Value = MonthStart + i - 1 & "월"
.Resize(, Datafieldnum).Merge
oMonthes.Add .Resize(, Datafieldnum)
For j = 1 To Datafieldnum
.Cells(2, j).Value = j
Next
.Cells(1, j).Value = MonthStart + i - 1 & "월 요약"
.Cells(1, j).Resize(2).Merge
End With
Next
For Each sht In ThisWorkbook.Sheets
Set rPaste = .Cells(10000).End(xlUp).Offset(1)
If Len(sht.Name) = 1 Then
Set rRawdata = sht.Range("a10000").End(xlUp).CurrentRegion
Set rRawdataHead = rRawdata.Rows(2)
Set rRawdataBody = rRawdata.Resize(rRawdata.Rows.Count - 2).Offset(2)
rRawdataBody.Resize(, 2).Copy rPaste
For Each rX In rRawdataHead.Cells
If rX.Value >= 1 And rX.Value <= 12 Then
iNum = rX
sMonth = rX.Offset(-1).MergeArea.Cells(1)
Set rCurrentCell = getCurrentBlock(iNum, sMonth, oMonthes)
Set rCurrentCell = Intersect(rCurrentCell.EntireColumn, rPaste.MergeArea.EntireRow)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
If rX.MergeCells Then
Set rMonthSummary = .EntireRow.Resize(2).Find(rX.MergeArea.Cells(1).Value)
Set rCurrentCell = Intersect(rCurrentCell.EntireRow, rMonthSummary.EntireColumn)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
Next
End If
Next
If MsgBox("빈열을 삭제하시겠습니까?", vbYesNo, "빈열 삭제") = vbYes Then
Dim rAll As Range
Set rAll = .CurrentRegion
Dim iCol As Integer
For iCol = rAll.Columns.Count To 1 Step -1
If Application.CountA(rAll.Columns(iCol)) = 1 Then
rAll.Columns(iCol).Delete ' 열 삭제 시 오른쪽 부터 삭제,
End If
Next
End If
End With
End Sub
Function getCurrentBlock(iNum As Integer, sMon As String, oMonthes As Collection)
Dim rBlock As Range
Dim varX As Variant
Dim rX As Range
For Each varX In oMonthes
Set rBlock = varX
If rBlock.Cells(1).Value = sMon Then
For Each rX In rBlock.Cells(1).Offset(1).Resize(, rBlock.Cells.Count).Cells
If rX.Value = iNum Then
Set rBlock = rX
GoTo X
End If
Next
End If
Next
X:
Set getCurrentBlock = rX
End Function
Function fdt발주일(ByVal c As Range, colAlpa)
Do
Set c = c(0)
Loop Until c = "상품코드"
fdt발주일 = c.Parent.Cells(c.Row - 1, colAlpa)
End Function
Sub sRef_vs_Val()
1 Dim c As Range
Set cd = [f4]
Set ct = cd
For Each c In [A4:A6]
dt = fdt발주일(c, "d")
2 ct.Resize(, 2) = Array(dt, c)
Set ct = ct(2)
Next
End Sub
ByRef : 인수 전달시 그 인수가 참조하는주소를 넘김. 프로시저를 정의할 때 인수 앞에 ByRef가 생략 됨.
ByVAl: 인수 전달시 그 인수 값 자체를 통째로 넘김.
Function getMonth(sWhat As String, sBasic As String, Optional ByRef iItem As Variant)
Dim iTemp As Integer
Dim shtX As Worksheet
Dim rHeadRow As Range
Dim rX As Range
Dim rBody As Range
If sWhat = "start" Then iTemp = 100
For Each shtX In Worksheets
If Len(shtX.Name) = 1 Then
If shtX.Range("A1") = sBasic Then
Set rBody = shtX.Range("A1").CurrentRegion
Else
Set rBody = shtX.Range("A1").End(xlDown).CurrentRegion
End If
Set rHeadRow = rBody.Rows(2)
For Each rX In rHeadRow.Cells
Dim iMon As Integer
iMon = Val(rX.Offset(-1))
If iMon > 0 Then
If sWhat = "end" Then
If iTemp < iMon Then
iTemp = iMon
End If
Else
If iTemp > iMon Then
iTemp = iMon
End If
If sWhat = "item" Then
If Not InStr(rX.Offset(-1), "요약") > 1 Then
If iItem(iMon) < rX.Offset(-1).MergeArea.Count Then
iItem(iMon) = rX.Offset(-1).MergeArea.Count
End If
End If
End If
End If
End If
Next
End If
Next
getMonth = iTemp
End Function
Function getMonth(sWhat As String)
Dim iMon As Integer
Dim iTemp1 As Integer
Dim iTemp2 As Integer
Dim sht As Worksheet
Dim rX As Range
Dim rHead As Range
Dim iNum As Integer
If sWhat = "start" Then iMon = 100
For Each sht In ThisWorkbook.Sheets
If Len(sht.Name) = 1 Then
Set rHead = sht.[a1000].End(xlUp).CurrentRegion.Rows(1)
For Each rX In rHead.Cells
If rX.MergeCells = True Then
iTemp1 = Val(rX.MergeArea.Cells(1).Value)
iTemp2 = rX.MergeArea.Count
If iTemp1 > 1 Then
If sWhat = "start" Then
If iMon > iTemp1 Then iMon = iTemp1
ElseIf sWhat = "end" Then
If iMon < iTemp1 Then iMon = iTemp1
End If
End If
If iNum < iTemp2 Then iNum = iTemp2
End If
Next
End If
Next
getMonth = IIf(sWhat = "NumPerEachMonth", iNum, iMon)
End Function
Option Explicit
Sub 시트통합2()
Dim rFieldname As Range
Dim shtSummary As Worksheet
Dim MonthStart, MonthEnd, MonthCnt As Integer
Dim iNumPerEachMonth As Integer
Dim i, j, iNum As Integer
Dim sht As Worksheet
Dim rRawdata, rRawdataHead, rRawdataBody As Range
Dim c As Range
Dim rPaste As Range
Dim sMonth As String
Dim oMonthes As New Collection
Dim rX As Range
Dim rCurrentCell As Range
Dim rMonthSummary As Range
Dim MonthArray()
MonthStart = getMonth("start")
MonthEnd = getMonth("end")
iNumPerEachMonth = getMonth("NumPerEachMonth")
MonthCnt = MonthEnd - MonthStart + 1
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Summary_report").Delete
On Error GoTo 0
Set shtSummary = Sheets.Add
shtSummary.Name = "Summary_report"
Set rFieldname = shtSummary.[a4]
With rFieldname
.Cells(2).Value = "Part Name"
.Cells(2, 2).Value = "구 분"
For i = 1 To MonthCnt
With .Cells(1, 3 + (iNumPerEachMonth + 1) * (i - 1))
.Value = MonthStart + i - 1 & "월"
.Resize(, iNumPerEachMonth).Merge
oMonthes.Add .Resize(, iNumPerEachMonth)
For j = 1 To iNumPerEachMonth
.Cells(2, j).Value = j
Next
.Cells(1, j).Value = MonthStart + i - 1 & "월 요약"
.Cells(1, j).Resize(2).Merge
End With
Next
For Each sht In ThisWorkbook.Sheets
Set rPaste = .Cells(10000).End(xlUp).Offset(1)
If Len(sht.Name) = 1 Then
Set rRawdata = sht.Range("a10000").End(xlUp).CurrentRegion
Set rRawdataHead = rRawdata.Rows(2)
Set rRawdataBody = rRawdata.Resize(rRawdata.Rows.Count - 2).Offset(2)
rRawdataBody.Resize(, 2).Copy rPaste
For Each rX In rRawdataHead.Cells
If rX.Value >= 1 And rX.Value <= 12 Then
iNum = rX
sMonth = rX.Offset(-1).MergeArea.Cells(1)
Set rCurrentCell = getCurrentBlock(iNum, sMonth, oMonthes)
Set rCurrentCell = Intersect(rCurrentCell.EntireColumn, rPaste.MergeArea.EntireRow)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
If rX.MergeCells Then
Set rMonthSummary = .EntireRow.Resize(2).Find(rX.MergeArea.Cells(1).Value)
Set rCurrentCell = Intersect(rCurrentCell.EntireRow, rMonthSummary.EntireColumn)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
Next
End If
Next
' If MsgBox("빈열을 삭제하시겠습니까?", vbYesNo, "빈열 삭제") = vbYes Then
Dim rAll As Range
Set rAll = .CurrentRegion
Dim iCol As Integer
For iCol = rAll.Columns.Count To 1 Step -1
If Application.CountA(rAll.Columns(iCol)) = 1 Then
rAll.Columns(iCol).Delete
End If
Next
' End If
End With
End Sub
Function getCurrentBlock(iNum As Integer, sMon As String, oMonthes As Collection)
Dim rBlock As Range
Dim varX As Variant
Dim rX As Range
For Each varX In oMonthes
Set rBlock = varX
If rBlock.Cells(1).Value = sMon Then
For Each rX In rBlock.Cells(1).Offset(1).Resize(, rBlock.Cells.Count).Cells
If rX.Value = iNum Then
Set rBlock = rX
GoTo X
End If
Next
End If
Next
X:
Set getCurrentBlock = rX
End Function
iStartMonth = getMonth("start", PART_NAME)
iEndMonth = getMonth("end", PART_NAME)
ReDim iNumPerEachMonth(iStartMonth To iEndMonth) As Integer
getMonth "item", PART_NAME, iNumPerEachMonth
Function getMonth(sWhat As String, sBasic As String, Optional ByRef iItem As Variant)
Dim iTemp As Integer
Dim shtX As Worksheet
Dim rHeadRow As Range
Dim rX As Range
Dim rBody As Range
If sWhat = "start" Then iTemp = 100
For Each shtX In Worksheets
If Len(shtX.Name) = 1 Then
If shtX.Range("A1") = sBasic Then
Set rBody = shtX.Range("A1").CurrentRegion
Else
Set rBody = shtX.Range("A1").End(xlDown).CurrentRegion
End If
Set rHeadRow = rBody.Rows(2)
For Each rX In rHeadRow.Cells
Dim iMon As Integer
iMon = Val(rX.Offset(-1))
If iMon > 0 Then
If sWhat = "end" Then
If iTemp < iMon Then
iTemp = iMon
End If
Else
If iTemp > iMon Then
iTemp = iMon
End If
If sWhat = "item" Then
If Not InStr(rX.Offset(-1), "요약") > 1 Then
If iItem(iMon) < rX.Offset(-1).MergeArea.Count Then
iItem(iMon) = rX.Offset(-1).MergeArea.Count
End If
End If
End If
End If
End If
Next
End If
Next
getMonth = iTemp
End Function
Sub mergeSheetsNew1()
Dim shtReport As Worksheet
Dim shtX As Worksheet
Dim rHeadRow As Range
Dim sShtToWork As Variant
Dim iMon As Integer
Dim iPart As Integer
Dim rMonStart As Range
Dim oMonthes As New Collection
Dim rX As Range
Dim rPaste As Range
Dim rBody As Range
Dim sMonth As String
Dim iNum As Integer
Dim rCurrentCell As Range
Dim rSum As Range
Dim iStartMonth As Integer
Dim iEndMonth As Integer
Dim iNextMonth As Integer
Const PART_NAME As String = "Part Name"
Const REPORT_NAME As String = "TotalReport"
On Error Resume Next
iStartMonth = getMonth("start", PART_NAME)
iEndMonth = getMonth("end", PART_NAME)
ReDim iNumPerEachMonth(iStartMonth To iEndMonth) As Integer
getMonth "item", PART_NAME, iNumPerEachMonth
sShtToWork = Array("A", "B", "C", "D", "E")
Application.DisplayAlerts = False
Worksheets(REPORT_NAME).Delete
Application.DisplayAlerts = True
Set shtReport = Worksheets.Add
With shtReport
.Name = "TotalReport"
.Range("A2") = PART_NAME
.Range("B2") = "구분"
Set rMonStart = .Range("B2")
For iMon = iStartMonth To iEndMonth
Set rMonStart = rMonStart.Offset(, iPart)
rMonStart.Offset(-1, 1) = iMon & "월"
rMonStart.Offset(-1, 1).Resize(, iNumPerEachMonth(iMon)).Merge ' iNumPerEachMonth).Merge
rMonStart.Offset(-1, 1).HorizontalAlignment = xlCenter
oMonthes.Add rMonStart.Offset(-1, 1).Resize(, iNumPerEachMonth(iMon)) ' iNumPerEachMonth)
For iPart = 1 To iNumPerEachMonth(iMon) ' iNumPerEachMonth
With rMonStart.Offset(, iPart)
.Value = iPart
.HorizontalAlignment = xlCenter
End With
Next
rMonStart.Offset(-1, iPart) = iMon & "월 요약"
rMonStart.Offset(-1, iPart).Resize(2).Merge
Next
For Each shtX In Worksheets
Set rPaste = .Range("B10000").End(xlUp).Offset(1, -1)
If Len(shtX.Name) = 1 Then
If shtX.Range("A1") = PART_NAME Then
Set rBody = shtX.Range("A1").CurrentRegion
Else
Set rBody = shtX.Range("A1").End(xlDown).CurrentRegion
End If
Set rHeadRow = rBody.Rows(2)
Set rBody = rBody.Offset(2).Resize(rBody.Rows.Count - 2)
rBody.Columns(1).Resize(, 2).Copy rPaste
For Each rX In rHeadRow.Cells
If rX.Value >= 1 And rX.Value <= 12 Then
iNum = rX
sMonth = rX.Offset(-1).MergeArea.Cells(1)
Set rCurrentCell = getCurrentBlock(iNum, sMonth, oMonthes)
Set rCurrentCell = Intersect(rPaste.MergeArea.EntireRow, rCurrentCell.EntireColumn)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
If rX.MergeCells Then
Set rSum = Intersect(rCurrentCell.EntireColumn, .Rows(2))
Do
Set rSum = rSum.Offset(, 1)
Loop While Not rSum.MergeCells
Set rSum = rSum.EntireColumn ' rSum.Offset(, 1).EntireColumn ' rSum.End(xlToRight).Offset(, 1).EntireColumn
With Intersect(rCurrentCell.EntireRow, rSum)
.Value = rX.Offset(1).Resize(3).Value
.Interior.ColorIndex = 6
End With
End If
Next
End If
Next
End With
End Sub
Option Explicit
Sub 시트통합2()
Dim rFieldname As Range
Dim shtSummary As Worksheet
Dim MonthStart, MonthEnd As Integer
Dim iNumPerEachMonth() As Variant
Dim i, j, iNum As Integer
Dim iMon As Integer
Dim sht As Worksheet
Dim rRawdata, rRawdataHead, rRawdataBody As Range
Dim c As Range
Dim rPaste As Range
Dim sMonth As String
Dim oMonthes As New Collection
Dim rX As Range
Dim rCurrentCell As Range
Dim rMonthSummary As Range
Dim MonthArray()
MonthStart = getMonth("start")
MonthEnd = getMonth("end")
ReDim iNumPerEachMonth(MonthStart To MonthEnd) As Variant
getMonth "item", iNumPerEachMonth
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Summary_report").Delete
On Error GoTo 0
Set shtSummary = Sheets.Add
shtSummary.Name = "Summary_report"
Set rFieldname = shtSummary.[a4]
With rFieldname
.Cells(2).Value = "Part Name"
.Cells(2, 2).Value = "구 분"
End With
Set rFieldname = rFieldname.Cells(, 3)
For iMon = MonthStart To MonthEnd
With rFieldname
.Value = iMon & "월"
.Resize(, iNumPerEachMonth(iMon)).Merge
oMonthes.Add .Resize(, iNumPerEachMonth(iMon))
For j = 1 To iNumPerEachMonth(iMon)
.Cells(2, j).Value = j
Next
.Cells(1, j).Value = iMon & "월 요약"
.Cells(1, j).Resize(2).Merge
Set rFieldname = rFieldname.Cells(, iNumPerEachMonth(iMon) + 2)
End With
Next
Set rFieldname = shtSummary.[a4]
With rFieldname
For Each sht In ThisWorkbook.Sheets
Set rPaste = .Cells(10000).End(xlUp).Offset(1)
If Len(sht.Name) = 1 Then
Set rRawdata = sht.Range("a10000").End(xlUp).CurrentRegion
Set rRawdataHead = rRawdata.Rows(2)
Set rRawdataBody = rRawdata.Resize(rRawdata.Rows.Count - 2).Offset(2)
rRawdataBody.Resize(, 2).Copy rPaste
For Each rX In rRawdataHead.Cells
If rX.Value >= 1 And rX.Value <= 12 Then
iNum = rX
sMonth = rX.Offset(-1).MergeArea.Cells(1)
Set rCurrentCell = getCurrentBlock(iNum, sMonth, oMonthes)
Set rCurrentCell = Intersect(rCurrentCell.EntireColumn, rPaste.MergeArea.EntireRow)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
If rX.MergeCells Then
Set rMonthSummary = .EntireRow.Resize(2).Find(rX.MergeArea.Cells(1).Value)
Set rCurrentCell = Intersect(rCurrentCell.EntireRow, rMonthSummary.EntireColumn)
rCurrentCell.Value = rX.Offset(1).Resize(3).Value
End If
Next
End If
Next
End With
End Sub
Function getCurrentBlock(iNum As Integer, sMon As String, oMonthes As Collection)
Dim rBlock As Range
Dim varX As Variant
Dim rX As Range
For Each varX In oMonthes
Set rBlock = varX
If rBlock.Cells(1).Value = sMon Then
For Each rX In rBlock.Cells(1).Offset(1).Resize(, rBlock.Cells.Count).Cells
If rX.Value = iNum Then
Set rBlock = rX
GoTo X
End If
Next
End If
Next
X:
Set getCurrentBlock = rX
End Function
Function getMonth(sWhat As String, Optional ByRef iItem As Variant)
Dim iMon As Integer
Dim iTemp1 As Integer
Dim iTemp2 As Integer
Dim sht As Worksheet
Dim rX As Range
Dim rHead As Range
If sWhat = "start" Then iMon = 100
For Each sht In ThisWorkbook.Sheets
If Len(sht.Name) = 1 Then
Set rHead = sht.[a1000].End(xlUp).CurrentRegion.Rows(1)
For Each rX In rHead.Cells
If rX <> "" Then
iTemp1 = Val(rX.MergeArea.Cells(1).Value)
If iTemp1 > 1 Then
If sWhat = "start" Then
If iMon > iTemp1 Then iMon = iTemp1
ElseIf sWhat = "end" Then
If iMon < iTemp1 Then iMon = iTemp1
End If
End If
If sWhat = "item" And Not InStr(rX, "요약") > 1 Then
iTemp2 = rX.MergeArea.Count
If iItem(iTemp1) < iTemp2 Then iItem(iTemp1) = iTemp2
End If
End If
Next
End If
Next
getMonth = iMon
End Function
shell, Dir, SendKeys
Dir
If Dir(sMyPath) = "" Then
MsgBox "AcroRd32.exe 실행화일이 없습니다"
Exit Sub
End If
Shell
sMyPath = "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe"
sMyFile = ThisWorkbook.Path & "\pdf\QT-001_REV.0.pdf"
Shell sMyPath & " " & sMyFile, vbNormalFocus
Shell명령으로 실행화일경로와 화일명
그리고 한칸 띄우고 열고자 하는 화일명, 그리고 vbNomalFocus라는 매개변수주고
SendKeys
Application.Wait Now + TimeValue("00:00:2")
SendKeys "%e", True
Application.Wait Now + TimeValue("00:00:2")
SendKeys "b"
SendKeys "%f"
SendKeys "x"
동일한 행에 노란색 칠하기
우노
Option Explicit
Sub compareRows()
Dim rTable As Range
Dim rRow As Range
Dim iCount As Integer
Set rTable = Me.Range("table").CurrentRegion
iCount = rTable.Columns.Count
For Each rRow In rTable.Rows
If Not rRow.Interior.ColorIndex = 6 Then
If isDupe(rRow, rTable, iCount) Then
rRow.Interior.ColorIndex = 6
End If
End If
Next
End Sub
Function isDupe(rRow As Range, rTable As Range, iCount As Integer)
Dim rRow_ As Range
Dim iX As Integer
For Each rRow_ In rTable.Rows
If rRow_.Address <> rRow.Address Then
For iX = 1 To iCount
If rRow_.Cells(iX) <> rRow.Cells(iX) Then
isDupe = False
GoTo NEXT_ROW
End If
Next
isDupe = True
rRow_.Interior.ColorIndex = 6
Exit Function
End If
NEXT_ROW:
Next
isDupe = False
End Function
Sub 중복행_표시하기()
Dim rTable As Range
Dim c1, c2 As Range
Dim vTarget(4) As Variant
Dim rNewtbl As Range
Set rTable = Sheets("연습").[b18].CurrentRegion
For Each c1 In rTable.Columns(1).Cells
For i = 0 To 4
vTarget(i) = c1.Cells(1, i + 1).Value
Next
Set rNewtbl = Range(c1, c1.End(xlToRight).End(xlDown))
Set rNewtbl = rNewtbl.Resize(rNewtbl.Rows.Count - 1).Offset(1)
For Each c2 In rNewtbl.Columns(1).Cells
j = 0
For i = 0 To 4
If vTarget(i) = c2.Cells(1, i + 1).Value Then j = j + 1
Next
If j = 5 Then
c2.Resize(, 5).Interior.Color = 65535
c1.Resize(, 5).Interior.Color = 65535
End If
Next
Next
End Sub
Sub 동일한행_노랑색표시()
Dim rTable As Range
Dim rRow As Range
Dim iColCount As Integer
Set rTable = ThisWorkbook.ActiveSheet.[b6].CurrentRegion
iColCount = rTable.Columns.Count
For Each rRow In rTable.Rows
If Not (rRow.Interior.ColorIndex = 6) Then
If isDup(rRow, rTable, iColCount) Then rRow.Interior.ColorIndex = 6
End If
Next
End Sub
Function isDup(rRow As Range, rTable As Range, iColCount As Integer)
Dim rRow_ As Range
Dim iNum As Integer
For Each rRow_ In rTable.Rows
If rRow_.Address <> rRow.Address Then
For iNum = 1 To iColCount
If rRow_.Cells(iNum) <> rRow.Cells(iNum) Then GoTo NEXT_ROW '대문자로만 써야 error 안남
Next
rRow_.Interior.ColorIndex = 6
isDup = True
End If
NEXT_ROW: '대문자로만 써야 error 안남
Next
End Function
Excel Baby_115 , LARGE,SMALL,SUMIF,IF,Logical Value,Conditional Format,CheckBox
raw data 중 상위 10개 or 하위 10개만 골라서 합계
상위 10개 합계
=SUMIF(C6:E16,">="&LARGE(C6:E16,10),C6:E16)
하위 10개 합계
=SUMIF(C6:E16,"<="&SMALL(C6:E16,10),C6:E16)
( C6:E16 : Raw data 범위)
수식의 한계 => 하위 10개 구할 때 하위 10번째 숫자가 동일하면 하위 10번째 숫자 두개를 모두 더함
체크박스 + 조건부서식 으로 상위 10개, 하위 10개 숫자 노랑색으로 표시하기
1) 체크 박스 => 컨트롤 서식 => 셀연결
2) 조건부 서식 => Raw data 범위 잡고
=IF($G$68=TRUE, C64<=SMALL($C$64:$E$74,10), C64<=LARGE($C$64:$E$74,10))
컨트롤 서식 연결 셀 : $G$68
Raw data 범위 : $C$64:$E$74
Sub changeFontStyle()
Dim rAll As Range
Dim shtX As Worksheet
Set shtX = Application.ActiveSheet
Set rAll = shtX.UsedRange
If rAll.Cells(1).Font.Italic = True Then
rAll.Font.Italic = False
Else
rAll.Font.Italic = True
End If
End Sub
Sub changeFontStyle1()
Dim rAll As Range
Set rAll = Cells.SpecialCells(xlCellTypeConstants)
rAll.Select
If rAll.Cells(1).Font.Italic = True Then
rAll.Font.Italic = False
Else
rAll.Font.Italic = True
End If
End Sub
Cells속성은 어떤 범위.Cells(1,1)등과 같이 접근도 하지만
만약 쩜찍지 않고 그냥 Cells라고 하면 현재 활성화된 시트의
모든 범위개체에 접근한다
ColumnDifferences......
시트 이름 순 정렬
Sub sheet정렬()
Dim shtTarget As Worksheet
Dim shtX As Worksheet
Dim shtY As Worksheet
For Each shtX In ThisWorkbook.Sheets
For Each shtY In ThisWorkbook.Sheets
If shtX.Name <> shtY.Name Then
If shtY.Name < shtX.Name Then shtY.Move before:=shtX
End If
Next
Next
End Sub
/*CREATE TABLE TEST (
A CHAR(1)
,B NUMERIC
)*/
select *
from
(select case when a.a is null then b.a else a.a end 문자열키
, case when a.b is null then 0 else a.b end 숫자1
, case when b.b is null then 0 else b.b end 숫자2
, case when a.b is null then 0 else a.b end - case when b.b is null then 0 else b.b end 차이
from
(SELECT * FROM TEST) a
full outer join
(SELECT * FROM TEST2) b
on (a.a = b.a)) c
where c.차이 <> 0
-- Table: test
-- DROP TABLE test;
CREATE TABLE test2
(
a character(1),
b numeric
)
WITH (
OIDS=FALSE
);
ALTER TABLE test
OWNER TO postgres;
select a.*
from
(select
CASE WHEN a.마감월도 ISNULL THEN b.마감월도 ELSE a.마감월도 END 마감월도
, CASE WHEN a.계약번호 ISNULL THEN b.계약번호 ELSE a.계약번호 END 계약번호
, CASE WHEN a.특별계정금액 ISNULL THEN 0 ELSE a.특별계정금액 END 특별계정금액
, CASE WHEN a.대출금액 ISNULL THEN 0 ELSE a.대출금액 END 대출금액
, CASE WHEN b.전월기준금액 ISNULL THEN 0 ELSE b.전월기준금액 END 전월기준금액
, CASE WHEN b.당월기준금액 ISNULL THEN 0 ELSE b.당월기준금액 END 당월기준금액
, CASE WHEN b.해지일 ISNULL THEN '' ELSE b.해지일 END 해지일
, CASE WHEN b.당월계약상태 ISNULL THEN '' ELSE b.당월계약상태 END 당월계약상태
from
(select 마감월도, 검증기준일, 계약번호, sum(특별계정금액) 특별계정금액, sum(대출금액) 대출금액
from 특별계정등록금액
where 마감월도 = '201508' and 검증기준일 = '1' --and not(특별계정금액 = 0 and 대출금액 = 0)
--and 계약번호 = 'L28050004415'
group by 마감월도, 검증기준일, 계약번호
) a
full outer join
(select 마감월도, 검증기준일, 계약번호, max(해지일) 해지일, max(당월계약상태) 당월계약상태, sum(전월기준금액) 전월기준금액, sum(당월기준금액) 당월기준금액
from 계리산출금액
where 마감월도 = '201508' and 검증기준일 = '1' --and not(전월기준금액 = 0 and 당월기준금액 = 0)
group by 마감월도, 검증기준일, 계약번호
) b
on (a.마감월도 = b.마감월도) and (a.검증기준일 = b.검증기준일) and (a.계약번호 = b.계약번호)) a
--where a.계약번호 = 'L28050004415'
where not(a.특별계정금액 = 0 and a.대출금액 = 0 and a.전월기준금액 = 0 and a.당월기준금액 = 0)
ORDER BY 계약번호
Sub case_구문()
Dim rTable As Range
Dim rRow As Range
Dim rGrade As Range
Dim sGradewriting As String
Set rTable = Range("table").CurrentRegion
Set rTable = rTable.Offset(1).Resize(rTable.Rows.Count - 1)
For Each rRow In rTable.Rows
Set rGrade = rRow.Cells(1, 2)
Select Case rGrade.Value
Case "A": sGradewriting = "Exelent"
Case "B": sGradewriting = "Good"
Case "C": sGradewriting = "Not bad"
Case "D": sGradewriting = "Pool"
Case "E": sGradewriting = "Failed"
End Select
rRow.Cells(1, 3) = sGradewriting
Next
End Sub
| 배열수식에서 MAX나 MIN함수등의 함정..
MAX나 MIN이나 배열을 대상으로 계산하는 것들은
배열 수식에서 사용할때 잠시 생각해 보시는 것이 좋다
논리함수인 AND나 OR함수에서도 배열수식에서는 안된다는 것을
이렇게 개별적 행을 처리하면 값이 나오는데..
배열로 처리하면 안되는구나…이것도 행별개별적으로 하지않고 열전체를 비교하니까..
그런 것.., 그래서 배열수식에서는 OR나 AND 논리함수는 사용하면 안된다
Sub 이름영역지정()
Dim rNameTable As Range
Dim RowCount As Variant
Set rNameTable = ThisWorkbook.Sheets("기초데이터(전표입력)").Range("a1").End(xlDown).CurrentRegion.Rows(1)
RowCount = Range(rNameTable.Cells(1), rNameTable.Cells(1).End(xlDown)).Count
For Each c In rNameTable.Cells
ActiveWorkbook.Names.Add c.Value, c.Resize(RowCount)
Next
End Sub
Sub 특약_담보_업데이트()
Dim rTable As Range
Dim rOld_PlanCode As Range
Dim rNew_PlanCode_match_OldVar As Range
Dim rNew_PlanCode_match_NewVar As Range
Dim rNew_Var_Name As Range
Dim rVar_Name_set As Range
Dim rTarget As Range
Dim rPeriod As Range
Dim vCount_Period As Variant
Dim vCount_New_Var_Name As Variant
Dim vCount_rVar_Name_set As Variant
'1.신규담보추가
Set rOld_PlanCode = Range([aa4], [aa4].End(xlDown))
Set rNew_Var_Name = Range([ad4], [ad4].End(xlDown))
vCount_New_Var_Name = rNew_Var_Name.Count
vCount_Period = 11
'1-1.기존 담보와 중복여부 확인(로직 생성 예정)
For Each c In rOld_PlanCode
Set rTarget = [b3].End(xlDown).Offset(1).Resize(rNew_Var_Name.Count)
rTarget.Value = c.Value
rTarget.Offset(, 1).Value = rNew_Var_Name.Value
Set rPeriod = rTarget.Offset(, 2).Resize(, vCount_Period)
rPeriod.Value = "'0"
Next
Set rTarget = Range([b4], [b4].End(xlDown)).Offset(, -1)
[A4].Copy rTarget.SpecialCells(xlCellTypeBlanks)
Set rTable = [b2].CurrentRegion
ActiveSheet.Sort.SortFields.Clear
rTable.Sort rTable.Cells(1, 2), xlAscending, , , , , , xlYes
'2.신규특약 추가
Set rVar_Name_set = Range([ah4], [ah4].End(xlDown))
vCount_rVar_Name_set = rVar_Name_set.Count
'2-1 기존 담보와 매칭되는 특약 추가
Set rNew_PlanCode_match_OldVar = Range([aj4], [aj4].End(xlDown))
For Each c In rNew_PlanCode_match_OldVar
Set rTarget = [b3].End(xlDown).Offset(1).Resize(vCount_rVar_Name_set)
rTarget.Value = c.Value
rTarget.Offset(, 1).Value = rVar_Name_set.Value
Set rTarget = rTarget.Offset(, 1).Resize(, vCount_Period + 1)
rTarget.Value = rTable.Columns(1).Find(c.Offset(, 2), rTable.Cells(1), xlValues).Offset(, 2).Resize(vCount_rVar_Name_set, vCount_Period + 1).Value
Next
'2-2 신규 담보와 매칭되는 특약 추가
Set rNew_PlanCode_match_NewVar = Range([aq4], [aq4].End(xlDown))
For Each c In rNew_PlanCode_match_NewVar
Set rTarget = [b3].End(xlDown).Offset(1).Resize(vCount_rVar_Name_set)
rTarget.Value = c.Value
rTarget.Offset(, 1).Value = rVar_Name_set.Value
Set rPeriod = rTarget.Offset(, 1).Find(c.Offset(, 1)).Offset(, 1).Resize(, vCount_Period)
rPeriod.Value = c.Offset(, 2).Resize(, vCount_Period).Value
Next
Set rTarget = Range([c3], [c3].End(xlDown)).Resize(, vCount_Period + 1)
rTarget.SpecialCells(xlCellTypeBlanks).Value = "'0"
rTarget.NumberFormatLocal = "@"
Set rTarget = Range([b3], [b3].End(xlDown)).Offset(, -1)
[A4].Copy rTarget.SpecialCells(xlCellTypeBlanks)
End Sub
Sub 특약_담보_업데이트()
Dim rOldData As Range, rInputdata1 As Range, rInputdata2 As Range, rNewData As Range
Dim rTable As Range
Dim rNew_PlanCode_match_OldVar As Range
Dim rNew_PlanCode_match_NewVar As Range
Dim ncOld_PlanCode As New Collection
Dim ncNew_Var_Name As New Collection
Dim ncVar_Name_set As New Collection
Dim rTarget As Range
Dim rPeriod As Range
Dim vCount_Period As Variant
Dim vCount_New_Var_Name As Variant
Dim vCount_ncVar_Name_set As Variant
Set rOldData = [b5]
Set rInputdata1 = [q5]
Set rInputdata2 = [ah5]
Set rNewData = [ak5]
rNewData.Resize(100000, 14).Clear
rOldData.CurrentRegion.Copy rNewData
'1.신규담보추가----------------------------------------------------------------------------------------------------------------------------
If Cells(Rows.Count, rInputdata1.Column).End(xlUp).Row <> 5 Then
On Error Resume Next
For Each c In Range(rInputdata1.Offset(1, 1), rInputdata1.Offset(1, 1).End(xlDown))
ncNew_Var_Name.Add c, CStr(c)
Next
On Error GoTo 0
vCount_New_Var_Name = ncNew_Var_Name.Count
'1-1 기존특약세트 생성
On Error Resume Next
For Each c In Range(rOldData.Offset(1, 1), rOldData.Offset(1, 1).End(xlDown))
ncOld_PlanCode.Add c, CStr(c)
Next
On Error GoTo 0
vCount_Period = Range(rOldData, rOldData.End(xlToRight)).Count - 3
'1-2. 기존특약에 신규담보 추가
For Each c1 In ncOld_PlanCode
Set rTarget = rNewData.Offset(1, 1).End(xlDown).Offset(1).Resize(ncNew_Var_Name.Count)
rTarget.Value = c1.Value
j = 0
For Each c2 In ncNew_Var_Name
j = j + 1
rTarget.Offset(, 1).Cells(j) = c2
Next
Set rPeriod = rTarget.Offset(, 2).Resize(, vCount_Period)
With rPeriod
.Value = "'0"
.NumberFormat = "@"
End With
Next
Set rTarget = Range(rNewData.Offset(1, 1), rNewData.Offset(1, 1).End(xlDown)).Offset(, -1)
rNewData.Offset(1).Copy rTarget.SpecialCells(xlCellTypeBlanks)
Set rTable = rNewData.CurrentRegion
ActiveSheet.Sort.SortFields.Clear
rTable.Sort rTable.Cells(1, 2), xlAscending, , , , , , xlYes
rTable.Rows(2).Copy
rTable.Offset(1).Resize(rTable.Rows.Count - 1).PasteSpecial Paste:=xlPasteFormats
End If
'1-3. 담보구성 세트 생성
On Error Resume Next
For Each c In Range(rNewData.Offset(1, 2), rNewData.Offset(1, 2).End(xlDown))
ncVar_Name_set.Add c, CStr(c)
Next
On Error GoTo 0
vCount_ncVar_Name_set = ncVar_Name_set.Count
'2.신규특약 추가--------------------------------------------------------------------------------------------------------------------------
'2-1 신규 담보와 매칭되는 특약 추가
If Cells(Rows.Count, rInputdata1.Column).End(xlUp).Row <> 5 Then
Set rNew_PlanCode_match_NewVar = Range(rInputdata1.Offset(1), rInputdata1.Offset(1).End(xlDown))
For Each c In rNew_PlanCode_match_NewVar
Set rTarget = rNewData.Offset(, 1).End(xlDown).Offset(1).Resize(vCount_ncVar_Name_set)
rTarget.Value = c.Value
j = 0
For Each c2 In ncVar_Name_set
j = j + 1
rTarget.Offset(, 1).Cells(j) = c2
Next
Set rPeriod = rTarget.Offset(, 1).Find(c.Offset(, 1)).Offset(, 1).Resize(, vCount_Period)
rPeriod.Value = c.Offset(, 2).Resize(, vCount_Period).Value
With rTarget.Resize(, vCount_Period + 2)
.SpecialCells(xlCellTypeBlanks).Value = "'0"
.NumberFormatLocal = "@"
End With
With rTarget.Offset(, -1).Resize(, vCount_Period + 3)
rTable.Rows(2).Copy
.PasteSpecial Paste:=xlPasteFormats
.Interior.Color = 15773696
End With
Next
End If
'2-2 기존 담보와 매칭되는 특약 추가
If Cells(Rows.Count, rInputdata2.Column).End(xlUp).Row <> 5 Then
Set rNew_PlanCode_match_OldVar = Range(rInputdata2.Offset(1), Cells(Rows.Count, rInputdata2.Column).End(xlUp))
For Each c In rNew_PlanCode_match_OldVar
Set rTarget = rNewData.Offset(, 1).End(xlDown).Offset(1).Resize(vCount_ncVar_Name_set)
rTarget.Value = c.Value
j = 0
For Each c2 In ncVar_Name_set
j = j + 1
rTarget.Offset(, 1).Cells(j) = c2
Next
With rTarget.Offset(, -1).Resize(, vCount_Period + 3)
rTable.Rows(2).Copy
.PasteSpecial Paste:=xlPasteFormats
.Interior.Color = 65535
End With
Next
Set rTarget = Range(rNewData.Offset(, 1), rNewData.Offset(, 1).End(xlDown)).Offset(, -1)
rNewData.Offset(1).Copy rTarget.SpecialCells(xlCellTypeBlanks)
End If
End Sub
Sub 한폴더의_여러_통합문서_취합하기()
Dim sht As Worksheet
Dim iShtNum As Integer
pat = ThisWorkbook.Path & "\" & Range("폴더이름") & "\"
srfile = Dir(pat & "*." & Range("확장자명"))
Do Until srfile = ""
Workbooks.Open pat & srfile
For Each sht In ActiveWorkbook.Sheets
sht.Copy after:=ThisWorkbook.Sheets(1)
Next
Workbooks(srfile).Close
srfile = Dir
Loop
iShtNum = ThisWorkbook.Sheets.Count
With ThisWorkbook
For i = 1 To iShtNum - 1
For j = i + 1 To iShtNum
If .Sheets(i).Name > .Sheets(j).Name Then
.Sheets(j).Move .Sheets(i)
End If
Next
Next
End With
End Sub
'Sub LPInt()
Public Function LPInt(sCrNo, sCloseYm, InsStrtDate As Date, 부리기산일 As Date, YearCnt, DayCnt)
Dim i, j As Integer
Dim vInt_Total As Variant
Dim vInt_Year As Variant
Dim vInt_Year_sub As Variant
Dim vInt_Temp As Variant
Dim vInt_Day As Variant
Dim vVarInt As Variant
Dim vYearMonth As Variant
Dim vPrdNum As Variant
Dim vInsStartYear As Variant
Dim rVarIntTbl As Range
Dim vYTD As Variant
Dim vNYD As Variant
Dim vDay_Count As Variant
Dim vDay_Count_Total As Variant
Dim vMonth_Count As Variant
Dim dtStart_Date As Date
'sCrNo = [b45].Value
'sCloseYm = [a45].Value
'InsStrtDate = [r45].Value
'부리기산일 = [bb45].Value
'YearCnt = [bd45].Value
'DayCnt = [be45].Value
dtStart_Date = 부리기산일
'연동이율 선택 정보
vPrdNum = IIf(Mid(sCrNo, 2, 2) = "27", 1, IIf(Mid(sCrNo, 2, 2) = "28", 3, 5))
vInsStartYear = Switch(Year(InsStrtDate) = 2014, 0, Year(InsStrtDate) = 2015, 1, Year(InsStrtDate) = 2016, 2) ' 수정필요
Set rVarIntTbl = Range("이율테이블")
'연단위 적립이율 산출
vInt_Year = 1
vInt_Year_sub = 0
If YearCnt > 0 Then
For i = 0 To YearCnt - 1
dtStart_Date = IIf(i = 0, dtStart_Date, NYD(dtStart_Date))
vYTD = NYD(DateSerial(Year(dtStart_Date), Month(dtStart_Date), Day(dtStart_Date))) - dtStart_Date
vMonth_Count = DateDiff("m", dtStart_Date, dtStart_Date + vYTD) + 1
vDay_Count = 0
vDay_Count_Total = 0
vInt_Year_sub = 0
For j = 0 To vMonth_Count - 1
'구간별 변동이율
vYearMonth = 년월변환(DateSerial(Year(부리기산일) + i, Month(부리기산일) + j, 1))
vVarInt = rVarIntTbl.Columns(1).Find(Int(vYearMonth)).Offset(, vPrdNum + vInsStartYear).Value
'변동이율 구간별 일수
dtStart_Date = dtStart_Date + IIf(j = 0, -1, vDay_Count)
vDay_Count = DayCntinMonth(dtStart_Date)
vDay_Count_Total = vDay_Count_Total + vDay_Count
If vDay_Count_Total >= vYTD Then
vDay_Count = vYTD - (vDay_Count_Total - vDay_Count)
End If
'적수
vInt_Temp = vDay_Count / vYTD * vVarInt
vInt_Year_sub = vInt_Year_sub + vInt_Temp
Next
vInt_Year = vInt_Year * (1 + vInt_Year_sub)
Next
End If
'연미만 적립이율 산출
vInt_Day = 0
If DayCnt > 0 Then
dtStart_Date = NYD(DateSerial(Year(부리기산일) + YearCnt - 1, Month(부리기산일), Day(부리기산일)))
vYTD = NYD(DateSerial(Year(dtStart_Date), Month(dtStart_Date), Day(dtStart_Date))) - dtStart_Date
vMonth_Count = DateDiff("m", dtStart_Date, DateSerial(Left(sCloseYm, 4), Mid(sCloseYm, 5, 2), 1)) + 1
vDay_Count = 0
vDay_Count_Total = 0
For j = 0 To vMonth_Count - 1
'구간별 변동이율
vYearMonth = 년월변환(DateSerial(Year(부리기산일) + YearCnt, Month(부리기산일) + j, 1))
vVarInt = rVarIntTbl.Columns(1).Find(Int(vYearMonth)).Offset(, vPrdNum + vInsStartYear).Value
'변동이율 구간별 일수
dtStart_Date = dtStart_Date + IIf(j = 0, -1, vDay_Count)
vDay_Count = DayCntinMonth(dtStart_Date)
If j = vMonth_Count - 1 Then vDay_Count = vDay_Count - 1
'적수
vInt_Temp = vDay_Count / vYTD * vVarInt
vInt_Day = vInt_Day + vInt_Temp
vDay_Count_Total = vDay_Count_Total + vDay_Count
Next
End If
vInt_Total = vInt_Year * (1 + vInt_Day) - 1
LPInt = vInt_Total
'[cd45] = vInt_Total
End Function
Function NYD(StartDate)
If Month(DateSerial(Year(StartDate) + 1, Month(StartDate), Day(StartDate))) <> Month(StartDate) Then
NYD = DateSerial(Year(StartDate) + 1, Month(StartDate) + 1, 1) - 1
Else
NYD = DateSerial(Year(StartDate) + 1, Month(StartDate), Day(StartDate))
End If
End Function
Function 말일(StartDate)
말일 = DateSerial(Year(StartDate), Month(StartDate) + 1, 1) - 1
End Function
Function DayCntinMonth(StartDate)
If Month(StartDate + 1) = Month(StartDate) Then
DayCntinMonth = DateSerial(Year(StartDate), Month(StartDate) + 1, 1) - 1 - StartDate
Else
DayCntinMonth = DateSerial(Year(StartDate), Month(StartDate) + 2, 1) - 1 - StartDate
End If
End Function
Function 년월변환(년월일날짜)
년월변환 = Year(년월일날짜) & Format(Month(년월일날짜), "00")
End Function
Function 연동형적립이율(증번, 마감월, 계약일 As Date, 부리기산일 As Date, 부리년수, 년미만일수)
Dim i, j As Integer
Dim vInt_Total As Variant
Dim vInt_Year As Variant
Dim vInt_Year_sub As Variant
Dim vInt_Temp As Variant
Dim vInt_Day As Variant
Dim vVarInt As Variant
Dim vYearMonth As Variant
Dim vPrdNum As Variant
Dim vInsStartYear As Variant
Dim rVarIntTbl As Range
Dim vYTD As Variant
Dim vNYD As Variant
Dim vDay_Count As Variant
Dim vDay_Count_Total As Variant
Dim vMonth_Count As Variant
Dim dtStart_Date As Date
'증번 = [b47].Value
'마감월 = [a47].Value
'계약일 = [r47].Value
'부리기산일 = [bc47].Value
'부리년수 = [be47].Value
'년미만일수 = [bf47].Value
vInt_Year = 1
vInt_Day = 0
dtStart_Date = 부리기산일
마감일 = 말일(DateSerial(Left(마감월, 4), Mid(마감월, 5, 2), 1))
'연동이율 선택 정보
vPrdNum = IIf(Mid(증번, 2, 2) = "27", 1, IIf(Mid(증번, 2, 2) = "28", 3, 5))
vInsStartYear = Switch(Year(계약일) = 2014, 0, Year(계약일) = 2015 And Mid(증번, 2, 2) = "27", 1, Year(계약일) = 2016 And Mid(증번, 2, 2) = "27", 2, _
Year(계약일) = 2015 And Mid(증번, 2, 2) <> "27", 0, Year(계약일) = 2016 And Mid(증번, 2, 2) = "27", 1)
Set rVarIntTbl = Range("이율테이블")
'연단위 적립이율 산출
vInt_Year = 1
vInt_Year_sub = 0
If 부리년수 > 0 Then
For i = 0 To 부리년수 - 1
vYTD = NYD(dtStart_Date) - dtStart_Date
vDay_Count = 0
vDay_Count_Total = 0
vInt_Year_sub = 0
Do
'구간별 변동이율
vYearMonth = 년월변환(dtStart_Date)
vVarInt = rVarIntTbl.Columns(1).Find(Int(vYearMonth)).Offset(, vPrdNum + vInsStartYear).Value
'변동이율 구간별 일수
vDay_Count = 부리시작일(dtStart_Date, 부리기산일) - dtStart_Date
dtStart_Date = 부리시작일(dtStart_Date, 부리기산일)
'적수
vInt_Temp = vDay_Count / vYTD * vVarInt
vInt_Year_sub = vInt_Year_sub + vInt_Temp
vDay_Count_Total = vDay_Count_Total + vDay_Count
Loop While vDay_Count_Total < vYTD
vInt_Year = vInt_Year * (1 + vInt_Year_sub)
Next
End If
'연미만 적립이율 산출
If 년미만일수 > 0 Then
dtStart_Date = NYD(DateSerial(Year(부리기산일) + 부리년수 - 1, Month(부리기산일), Day(부리기산일)))
vYTD = NYD(DateSerial(Year(dtStart_Date), Month(dtStart_Date), Day(dtStart_Date))) - dtStart_Date
vDay_Count = 0
vDay_Count_Total = 0
Do
'구간별 변동이율
vYearMonth = 년월변환(dtStart_Date)
vVarInt = rVarIntTbl.Columns(1).Find(Int(vYearMonth)).Offset(, vPrdNum + vInsStartYear).Value
'변동이율 구간별 일수
If 부리시작일(dtStart_Date, 부리기산일) > 마감일 Then
vDay_Count = 마감일 - dtStart_Date
dtStart_Date = 마감일
Else
vDay_Count = 부리시작일(dtStart_Date, 부리기산일) - dtStart_Date
dtStart_Date = 부리시작일(dtStart_Date, 부리기산일)
End If
'적수
vInt_Temp = vDay_Count / vYTD * vVarInt
vInt_Day = vInt_Day + vInt_Temp
vDay_Count_Total = vDay_Count_Total + vDay_Count
Loop While dtStart_Date < 마감일
End If
vInt_Total = vInt_Year * (1 + vInt_Day) - 1
연동형적립이율 = vInt_Total
'[ce47] = vInt_Total
End Function
Function NYD(StartDate)
If Month(DateSerial(Year(StartDate) + 1, Month(StartDate), Day(StartDate))) <> Month(StartDate) Then
NYD = DateSerial(Year(StartDate) + 1, Month(StartDate) + 1, 1) - 1
Else
NYD = DateSerial(Year(StartDate) + 1, Month(StartDate), Day(StartDate))
End If
End Function
Function 말일(StartDate)
말일 = DateSerial(Year(StartDate), Month(StartDate) + 1, 1) - 1
End Function
Function 부리시작일(StartDate, 부리기산일)
If Month(StartDate) = Month(부리기산일) And Day(StartDate) = Day(부리기산일) Then
부리시작일 = 말일(StartDate) + 1
ElseIf Month(StartDate) = Month(부리기산일) Then
부리시작일 = DateSerial(Year(StartDate), Month(부리기산일), Day(부리기산일))
Else
부리시작일 = 말일(StartDate) + 1
End If
End Function
Function DayCntinMonth(StartDate)
If Month(StartDate + 1) = Month(StartDate) Then
DayCntinMonth = DateSerial(Year(StartDate), Month(StartDate) + 1, 1) - 1 - StartDate
Else
DayCntinMonth = DateSerial(Year(StartDate), Month(StartDate) + 2, 1) - 1 - StartDate
End If
End Function
Function 년월변환(년월일날짜)
년월변환 = Year(년월일날짜) & Format(Month(년월일날짜), "00")
End Function
Dim 구분 As New Collection
Dim 표1, 표2, 표3, 표4, 표5 As Range
Set 표2 = [f2:h9]
Set 표3 = [b12:d19]
Set 표4 = [f12:f19]
Set 구분목록 = Union(표1.Columns(1), 표2.Columns(1), 표3.Columns(1), 표4.Columns(1))
On Error Resume Next
구분.Add c, CStr(c)
On Error GoTo 0
Next
For Each c In 구분
[b22].Offset(i) = c
i = i + 1
Next
표5.Consolidate Sources:=Array(표1.Address(ReferenceStyle:=xlR1C1), _
표2.Address(ReferenceStyle:=xlR1C1), _
표3.Address(ReferenceStyle:=xlR1C1), _
표4.Address(ReferenceStyle:=xlR1C1)), _
Function:=xlAverage, TopRow:=True, LeftColumn:=True, CreateLinks:=False
End Sub
if (XMLUtil.getString(doc, "sTestFlag").equals("T")) { //TEST일때만 LOG
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", " --------------------------------------------------------------------");
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", " LTIKD12 계약번호 == " + XMLUtil.getString(doc,"sCrNo") + " ==상품코드 == " + XMLUtil.getString(doc,"sGdCd"));
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", " doc == " + doc);
}
String sCurmmPacctCrStatCd = XMLUtil.getString(doc, "sCurmmPacctCrStatCd");
/*------------------------------------------------------------------------------------------------------
* 1.총상각월수 산출
* -----------------------------------------------------------------------------------------------------
* 총상각월수 = min(납입기간년수,7) * 12
*/
int nTotDprMct = 0; //총상각월수
if (XMLUtil.getInt(doc, "nRealPaymTerm") > 7) {
nTotDprMct = 7 * 12;
} else {
nTotDprMct = XMLUtil.getInt(doc, "nRealPaymTerm") * 12;
}
XMLUtil.setInt (doc, "nTotDprMct" , nTotDprMct); //총상각월수
//Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", "총상각월수== " + nTotDprMct);
/*------------------------------------------------------------------------------------------------------
* 2.경과월수 산출
* -----------------------------------------------------------------------------------------------------
* 경과월수 = 경과년수*12 + 경과월수
*/
int nBfmmElapsMct = XMLUtil.getInt(doc, "nBfmmElapsYct") * 12 + XMLUtil.getInt(doc, "nBfmmElapsMct"); //전월
int nCurmmElapsMctt = XMLUtil.getInt(doc, "nCurmmElapsYct") * 12 + XMLUtil.getInt(doc, "nCurmmElapsMct"); //당월
// if (XMLUtil.getString(doc, "sTestFlag").equals("T")) { //TEST일때만 LOG
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", "전월경과월수== " + nBfmmElapsMct);
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", "당월경과월수== " + nCurmmElapsMctt);
// }
//비일시납 이고 보유건 중에서 유예납건 만 처리
//if (! XMLUtil.getString(doc, "sPaymCyclCd").equals("99") &&
// XMLUtil.getString(doc, "sCurmmPacctCrStatCd").equals("00")) {
//N1306-00096:계리결산프로그램 수정 요청(2013.06.17)
if (XMLUtil.getString(doc, "sCurmmPacctCrStatCd").equals("00")) {
//유예납 (전월경과월수 == 당월경과월수) 인 경우
//당월경과월수 (마감경과월수 = 마감년월 - 보험시작년월 + 1)
//N1305-00103:이연상각 로직 오류 수정(2013.05.09)
int nCloseElapsMct = (Integer.parseInt(XMLUtil.getString(doc, "sCloseYm").substring(0,4)) * 12 + Integer.parseInt(XMLUtil.getString(doc, "sCloseYm").substring(4,6))) -
(Integer.parseInt(XMLUtil.getString(doc, "sInsurStrtDate").substring(0,4)) * 12 + Integer.parseInt(XMLUtil.getString(doc, "sInsurStrtDate").substring(4,6))) + 1;
if ( ((nBfmmElapsMct > 0) && (nBfmmElapsMct == nCurmmElapsMctt)) ||
((nBfmmElapsMct > 0) && (nCurmmElapsMctt != nCloseElapsMct )) ||
XMLUtil.getString(doc, "sPaymCyclCd").equals("99") ){
nCurmmElapsMctt = nCloseElapsMct;
// if (XMLUtil.getString(doc, "sTestFlag").equals("T")) { //TEST일때만 LOG
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", "계리계약상태코드== " + XMLUtil.getString(doc, "sCurmmPacctCrStatCd"));
// Logger.info("KCL010Batch", "calculaPaccNwcrCrfwDprReslt", "당월경과월수(유예)== " + nCurmmElapsMctt);
// }
}
}
