- ©«¤l
- 438
- ¥DÃD
- 67
- ºëµØ
- 0
- ¿n¤À
- 531
- ÂI¦W
- 0
- §@·~¨t²Î
- win7
- ³nÅ骩¥»
- office 2010
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-10-30
- ³Ì«áµn¿ý
- 2024-11-19
|
¦^´_ 7# Andy2483
ÁÂÁ«e½ú«üÂI¡A²Å¦X¨ì½d¨Òn¨D¡A¥Ñ©ó¤¤¤å²ÁcÅé°ÝÃD¡A©Ò¥H§Ú°µ¤F¥H¤U½Õ¾ã¡C
Option Explicit
Sub Total()
Dim Brr, Crr, Z, i&, N&, R&, s%, T$, xR As Range
Dim a, b As Integer
Set Z = CreateObject("Scripting.Dictionary")
Sheets("Total").Range([W3], [A65536].End(xlUp)(3)).Delete Shift:=xlUp: Set xR = [Total!A3]
For s = 1 To 4
Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
For i = 2 To UBound(Brr)
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) = Sheets("KP").Range("C1") Or Brr(i, 15) = Sheets("KP").Range("C1") Then Crr(R, 5) = Sheets("KP").Range("C1")
If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> Sheets("KP").Range("C1") Then Crr(R, 5) = "-"
i01: Next
xR.Resize(N, 5) = Crr: xR(-1) = "No." & Sheets(s).Name
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
Next
a = Cells(Rows.Count, 1).End(3).Row
With Range("A3", "E" & a)
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
a = Cells(Rows.Count, 7).End(3).Row
With Range("G3", "K" & a)
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
a = Cells(Rows.Count, 13).End(3).Row
With Range("M3", "Q" & a)
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
a = Cells(Rows.Count, 19).End(3).Row
With Range("S3", "W" & a)
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub |
-
-
1.rar
(187.12 KB)
|