- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-11-28
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-6-8 16:45 ½s¿è
¦^´_ 11# shuo1125
ÁÂÁ«e½úµoªí¦¹¥DÃD»P«á¾Ç¤@°_¾Ç²ß,ÁÂÁ¦U¦ì«e½ú,ÁÂÁ½׾Â
«á¾Ç¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Sub TEST_1() '¡ô
Dim Brr, Crr(1 To 100, 1 To 100), Z, A, B$, i&, R&, C%, Y&, X%, T$, K%, S%, N&, M, Q
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary"): C = 1: R = 1
'¡ô¥OZÅܼƬO ¦r¨å,¥OC»PRªº°_©lȬO 1
A = Array(0, 5000, 10000, 50000, 100000, 500000, 10 ^ 6, 5000000, 10 ^ 7, 10 ^ 10)
'¡ô¥OAÅܼƬO ¤@ºû°}¦C,§G¤J·Qnªºª÷ÃB¯Å¶Z
K = UBound(A): S = K + 3
'¡ô¥OKÅܼƬOA°}¦C³Ì¤j¯Á¤Þ¸¹,(PS:A°}¦Cªº³Ì¤p¯Á¤Þ¸¹¬O 0)
For i = 0 To K - 1
R = R + 1
Crr(R, 1) = A(i) + 1 & "~" & vbLf & A(i + 1): Crr(R + S, 1) = Crr(R, 1)
Z(A(i + 1) & "$") = R: Z(A(i + 1) & "N") = R + S
Next
'¡ô³]¶¶°j°é±N¼ÐÃDÄæ¼g¤JCrr°}¦C¤¤,¨Ã¥OZ¦r¨å°O¦í¯Å¶Z©Ò¦bªºCrr°}¦C¦C¸¹
Brr = Range([¸ê®Æ!D2], [¸ê®Æ!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥H¸ê®ÆªíA~DÄæÀx¦s®æȱa¤J°}¦C¤¤
Sheets("²Îp").UsedRange.Clear
'¡ô¥O²Îpªí¦³¨Ï¥ÎªºÀx¦s®æ²M°£
With Sheets("²Îp").[A1:D4].Resize(UBound(Brr))
.Value = Brr
.Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1: Brr = .Value
'¡ô¥OBrr°}¦CÈ¥ý¼g¤J¦b²Îpªí¤¤¥ý°µ¥H²Ä1Ä欰°ò·Çªº¶¶±Æ§Ç
For i = 1 To UBound(Brr)
T = Brr(i, 1)
If Z(T & "y") = "" Then
C = C + 1: Crr(1, C) = T: Z(T & "y") = C: Crr(S + 1, C) = T
End If
Next
'¡ô³]¶¶°j°é!¥O¼ÐÃD¦C¼g¤JCrr°}¦C¤¤,¨Ã¥OZ¦r¨å°O¦í¦~¤À©Ò¦bªºÄ渹
.Sort KEY1:=.Item(4), Order1:=1, Header:=2, Orientation:=1
'¡ô¥O¸Ó½d³òÀx¦s®æ°µ¥H²Ä4Ä欰°ò·Çªº¶¶±Æ§Ç
Brr = .Value: .Clear
'¡ô¥OBrr°}¦C²±¸Ë°}¦CÈ,¥O¸Ó½d³òÀx¦s®æ²M°£
End With
Crr(1, 1) = "·JÁ`-NTD": Crr(S + 1, 1) = "·JÁ`-QTY": B = "[Total]"
R = R + 1: Crr(R, 1) = B: Crr(R + S, 1) = B
C = C + 1: Crr(1, C) = B: Crr(S + 1, C) = B
'¡ô¥O¥D¼ÐÃD»PÁ`©M¼ÐÃD¼g¤JCrr°}¦C¤¤
'================================================
For i = 1 To UBound(Brr)
Q = Val(Brr(i, 4))
If Q > M Then N = N + 1: M = A(N)
X = Z(Brr(i, 1) & "y"): Y = Z(M & "$")
Crr(Y, X) = Crr(Y, X) + Q: Crr(R, X) = Crr(R, X) + Q
Crr(Y, C) = Crr(Y, C) + Q: Crr(R, C) = Crr(R, C) + Q
Crr(Y + S, X) = Crr(Y + S, X) + 1: Crr(R + S, X) = Crr(R + S, X) + 1
Crr(Y + S, C) = Crr(Y + S, C) + 1: Crr(R + S, C) = Crr(R + S, C) + 1
Next
'¡ô³]¶¶°j°é±NBrr°}¦Cªºª÷ÃB±q¤p¨ì¤j¬Û¥[¦bCrr°}¦C¤¤
With [²Îp!A1].Resize(R + S, C)
.Columns.ColumnWidth = 14
Intersect(.Cells, Rows("1:" & K + 2)).Borders.LineStyle = 1
Intersect(.Cells, Rows(S + 1 & ":" & R + S)).Borders.LineStyle = 1
Union(.Rows(1), .Rows(K + 2), .Rows(S + 1)).Font.Bold = True
Union(.Rows(R + S), .Columns(C)).Font.Bold = True
Range([B2], .Cells(K + 2, C)).NumberFormatLocal = "#,##0_ "
Range(.Cells(S + 2, 2), .Cells(R + S, C)).NumberFormatLocal = "#,##0_ "
.Value = Crr
End With
'¡ô³B²z²Îpªí¥²nÀx¦s®æ®æ¦¡,³Ì«á¶ñ¤JCrr°}¦CÈ
Set Z = Nothing: Erase Brr, Crr, A
'¡ôÄÀ©ñÅܼÆ
End Sub |
|