|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
일별 주차별 월별 3개의 시트가 있는데
일별에만 입력하면 자동으로 주차별과 월별에도 입력되게끔 해주세요
==============[PinkH님 글에 대한 답변입니다]==============
워크시트 이벤트 함수(VBA)를 이용했습니다...
추가로 1년의 주는 최대 53주까지 있어 추가했습니다...
파일 첨부하오니 참고하세요....
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 3 Or Target.Column < 5 Then Exit Sub
If Intersect(Target, Me.UsedRange) Is Nothing Then Exit Sub
If Target.EntireRow.Cells(1, 4) = "합 계" Then Exit Sub
Dim rDate As Range
Set rDate = Range(Me.[E2], Me.[E2].End(xlToRight).Offset(0, -1))
Application.EnableEvents = False ' 이벤트 중지
Call UpdateSheet(rDate, Target.Row)
Application.EnableEvents = True
End Sub
Sub UpdateSheet(rDate As Range, iRow As Integer)
Dim shtWeek As Worksheet, shtMonth As Worksheet
Dim rX As Range
Dim iNum As Integer
Dim lWeekSum(1 To 53) As Long
Dim lMonthSum(1 To 12) As Long
With Application ' 실행 속도을 높이기 위함
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set shtWeek = Worksheets("2019주차")
Set shtMonth = Worksheets("2019월별")
For Each rX In rDate.Cells
iNum = Month(rX)
lMonthSum(iNum) = lMonthSum(iNum) + Me.Cells(iRow, rX.Column)
iNum = WorksheetFunction.WeekNum(rX)
lWeekSum(iNum) = lWeekSum(iNum) + Me.Cells(iRow, rX.Column)
Next
shtMonth.Cells(iRow, 5).Resize(, 12) = lMonthSum
shtWeek.Cells(iRow, 5).Resize(, 53) = lWeekSum
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
|
|