- ©«¤l
- 2833
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2889
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-15
|
¥»©«³Ì«á¥Ñ ã´£³¡ªL ©ó 2015-10-23 14:01 ½s¿è
¨S¦³Â²«K¼gªk¡A¥u¯à³v¤@®M¡A
¦³ÂI½ÆÂø¡A½Ð¦Û¦æºCºC¬ã¨s¡Aµ{¦¡½X¤Ó¦h¡AµLªk¤@¤@¸Ñ»¡¡G
¡@
Sub ²Îp()
Dim j&, k&, Arr, Brr, R&, C&, LB, Day1&, Day2&
Dim Crr, Drr, iDate, DV&, D&, M&, SS
With Sheets(1).UsedRange.Offset(1, 0)
¡@¡@Arr = .Columns("C"): R = UBound(Arr) - 1
¡@¡@Brr = .Columns("N:DU"): C = UBound(Brr, 2)
¡@¡@Day1 = CDate(Left(.Parent.Name, 4) & "/1/1")
¡@¡@Day2 = CDate(Left(.Parent.Name, 4) & "/12/31")
¡@¡@DV = Day2 - Day1 + 1
End With
¡@
ReDim Crr(1 To DV, 1 To C), Drr(1 To 12, 1 To C)
For j = 2 To R
¡@¡@iDate = Arr(j, 1): If Not IsDate(iDate) Then GoTo 101
¡@¡@If iDate < Day1 Or iDate > Day2 Then GoTo 101
¡@¡@D = iDate - Day1 + 1: M = Month(iDate)
¡@¡@For k = 1 To C
¡@¡@¡@¡@SS = Crr(D, k) + Brr(j, k)
¡@¡@¡@¡@If SS <> 0 Then Crr(D, k) = SS
¡@¡@¡@¡@SS = Drr(M, k) + Brr(j, k)
¡@¡@¡@¡@If SS <> 0 Then Drr(M, k) = SS
¡@¡@Next k
101: Next j
¡@
With Sheets("¼Æ¶q²Îp")
¡@¡@.UsedRange.EntireRow.Delete
¡@¡@.[B1].Resize(R, C) = Brr: .[A1] = "¥Í²£¤é´Á"
¡@¡@.[A1].Resize(R) = Arr
¡@¡@.[A1].Resize(R).NumberFormatLocal = "yyyy/mm/dd"
¡@¡@With .Cells(R + 1, 1).Resize(1, C + 1)
¡@¡@¡@¡@.Formula = "=IF(COLUMN()=1,""TOTAL"",SUM(A2:A" & R & "))"
¡@¡@¡@¡@.Borders(xlEdgeTop).LineStyle = xlContinuous
¡@¡@¡@¡@.Borders(xlEdgeBottom).LineStyle = xlDouble
¡@¡@End With
End With
¡@
With Sheets("¤é´Á²Îp")
¡@¡@.UsedRange.EntireRow.Delete
¡@¡@.[B1].Resize(1, C) = Brr: .[A1] = "¥Í²£¤é´Á"
¡@¡@.[A2].Resize(DV, 1) = "=" & Day1 & "+ROW(A1)-1"
¡@¡@.[A2].Resize(DV, 1).NumberFormatLocal = "yyyy/mm/dd"
¡@¡@.[B2].Resize(DV, C) = Crr
¡@¡@With .Cells(DV + 2, 1).Resize(1, C + 1)
¡@¡@¡@¡@.Formula = "=IF(COLUMN()=1,""TOTAL"",SUM(A2:A" & DV + 1 & "))"
¡@¡@¡@¡@.Borders(xlEdgeTop).LineStyle = xlContinuous
¡@¡@¡@¡@.Borders(xlEdgeBottom).LineStyle = xlDouble
¡@¡@End With
End With
¡@
With Sheets("¤ë¥÷²Îp")
¡@¡@.UsedRange.EntireRow.Delete
¡@¡@.[B1].Resize(1, C) = Brr: .[A1] = "¥Í²£¤ë¥÷"
¡@¡@.[A2].Resize(12) = "=TEXT(ROW(A1),""00¤ë"")"
¡@¡@.[B2].Resize(12, C) = Drr
¡@¡@With .Cells(14, 1).Resize(1, C + 1)
¡@¡@¡@¡@.Formula = "=IF(COLUMN()=1,""TOTAL"",SUM(A2:A13))"
¡@¡@¡@¡@.Borders(xlEdgeTop).LineStyle = xlContinuous
¡@¡@¡@¡@.Borders(xlEdgeBottom).LineStyle = xlDouble
¡@¡@End With
End With
End Sub
¡@
ªþÀɤU¸ü¡G
Xl0000147(¼Æ¶q²Îp).rar (27.39 KB)
¡@ |
|