- ©«¤l
- 2839
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2895
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-12-27
|
¦^´_ 23# shuo1125
Sub TEST_A4()
Dim Arr, Brr, Cr, xD, vD, i&, j%, R&, K, T1$, T2$, TT$, N&, V%, xA As Range
tm = Timer
Call ²M°£
Set xD = CreateObject("Scripting.Dictionary")
Set vD = CreateObject("Scripting.Dictionary")
Arr = Range([DATA!at1], [DATA!a65536].End(xlUp))
For i = 2 To UBound(Arr)
If Arr(i, 46) <> "" Then GoTo i01
T1 = Arr(i, 11): T2 = Arr(i, 6): TT = T1 & T2
If T1 = "" Or T2 = "" Or xD(TT) > 0 Then GoTo i01
If xD(T1) = 0 Then Set vD(T1) = CreateObject("Scripting.Dictionary")
xD(T1) = 1: xD(TT) = 1: vD(T1)(i) = ""
i01: Next i
'--------------------------------
Application.ScreenUpdating = False
Set xA = [½LÂIªí!A1]: Cr = Array(1, 3, 6, 8, 10, 14, 13, 12)
For Each K In vD.keys
R = vD(K).Count: N = N + 1
ReDim Brr(1 To R + 1, 1 To 10)
For i = 1 To R
V = vD(K).keys()(i - 1)
Brr(i + 1, 5) = "¤pp¡G": Brr(i + 1, 8) = Brr(i, 8) + Arr(V, 12)
For j = 1 To 8: Brr(i, j) = Arr(V, Cr(j - 1)): Next
Brr(i, 10) = "¤f¤Hû ¤f¦aÂI ¤f¥\¯à"
Next i
[½LÂIªí!A1:j3].Copy xA
xA(2, 2) = K: xA(2, 10) = "¶¦¸¡G" & N & "/" & vD.Count
[½LÂIªí!a4:j4].Copy xA(4).Resize(R, 10)
xA(4).Resize(R + 1, 10).Value = Brr
Set xA = xA(R + 5): xA.PageBreak = xlPageBreakManual '³]©w¤À¶½u
Next
MsgBox Timer - tm
End Sub |
|