- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«×q¤è®×½Æ²ßµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Sub Total()
Dim Arr, Brr, Crr, Z, i&, N&, R&, s%, T$, A$, xR As Range, xT As Range
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,%¬Oµu¾ã¼Æ,¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
With Sheets("Total").UsedRange
.Offset(2).EntireRow.Delete
.Offset(, 5).EntireColumn.Delete
Set xT = .Item(1).Resize(2, 5): Set xR = .Item(3, 1): A = [KP!C1]
End With '¦¹¬q¬O¯d¤U¤@Ó¼ÐÃDÀx¦s®æ,¨ä¾l¸ê®ÆÄæ/¦C§R°£
For s = 1 To 4
'¡ô³]¶¶°j°é!¥OsÅܼƱq1 ¨ì4
Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
'¡ô¥OBrrÅܼƬO¼g¤J°Ï°ìÀx¦s®æȪº¤Gºû°}¦C,«Å§iCrrÅܼƬO¤GºûªÅ°}¦C
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!¥OiÅܼƱq2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
If Brr(i, 14) = A Or Brr(i, 15) = A Then Crr(R, 5) = A
If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> A Then Crr(R, 5) = "-"
i01: Next '¦¹¬q¬O¨Ì±ø¥ó±Nµ²ªG¼g¤JCrr°}¦C¤¤
xT.Copy xR(-1): xR(-1) = "No." & Sheets(s).Name
'¡ô¥O¼ÐÃDÀx¦s®æ½Æ»s¨ì¥Ø¼Ð®æ,¥O¼ÐÃD®æ¼g¤J¤u§@ªí¦W
With xR.Resize(N, 5)
.Value = Crr
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Columns(3).Font.ColorIndex = 3
.Columns(4).Font.ColorIndex = 5
.Font.Bold = True
End With '¦¹¬q¬O¥OÂX®i¾A¶qÀx¦s®æ½d³ò¥HCrr°}¦Cȼg¤J,¨Ã½Õ¾ã¸Ó½d³ò®æ¦¡
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
'¡ô¥ONÅܼÆÂk¹s,Z¦r¨å²MªÅ,¥OxRÅܼƥk²¾¨ì¦Û¨¶}©lªº²Ä7®æ
Next
End Sub |
|