¤ÀÃþ²Î­p¦p¦ó¼¶¼gVBA

aa7551

ªþ¥ó¤¤¦³¸ê®Æ¤Î²Î­p¤G¤u§@ªí,¸ê®Æ¤¤¦³¤ÀÃþ¤@,¤G,¤T,¥|,¦b²Î­p®É§Æ±æ¯à±N¤ÀÃþµ²¦X©R¦W¤­½X(¤ÀÃþ¤@,¤G,¤T,¥|µ²¦X),¦pªþ¥ó²Ä¤@µ§,¤­½X¬°22203,¤T½X¬°222,¤G½X¬°22,¤@½X¬°2,­pºâª÷ÃB¤Î¥ó¼Æ¦p²Î­p¤u§@ªí
½Ð¨D¨ó§U

hcm19522

E2=SUMPRODUCT((--LEFT(A$2:A$64,3)=D2)*B$2:B$64)
F2=SUMPRODUCT((--LEFT(A$2:A$64,3)=D2)*C$2:C$64)
H2=SUMPRODUCT((--LEFT(A$2:A$64,2)=G2)*B$2:B$64)
I2=SUMPRODUCT((--LEFT(A$2:A$64,2)=G2)*C$2:C$64)
H8=SUMPRODUCT((--LEFT(A$2:A$64)=G8)*B$2:B$64)
I8=SUMPRODUCT((--LEFT(A$2:A$64)=G8)*C$2:C$64)

aa7551

·PÁ¦^µª,¤u§@ªí²Î­p¤¤¤­½X¬O¤â¤u­pºâ¦Ó¨Ó,§Æ±æ¨ó§U¨Ï¥ÎVBA

­ã´£³¡ªL

Sub ¤ÀÃþ²Î­p()
Dim xD, xR As Range, Arr, Brr, i&, j%, Jm&, T, N&, C&(1 To 4)
Sheets("²Î­p").UsedRange.Offset(1, 0).EntireRow.Delete
Arr = Range([¸ê®Æ!A2], [¸ê®Æ!A65536].End(xlUp)(1, 5))
ReDim Brr(1 To UBound(Arr), 1 To 12)
Set xD = CreateObject("Scripting.Dictionary")
¡@
For i = 1 To UBound(Arr)
¡@¡@T = 0
For j = 1 To 4
¡@¡@T = T * IIf(j = 4, 100, 10) + Arr(i, j + 1)
¡@¡@Jm = xD(T)
¡@¡@If Jm = 0 Then C(j) = C(j) + 1: Jm = C(j): xD(T) = Jm
¡@¡@If Jm > N Then N = Jm
¡@¡@Brr(Jm, 12 - j * 3 + 1) = T
¡@¡@Brr(Jm, 12 - j * 3 + 2) = Brr(Jm, 12 - j * 3 + 2) + Arr(i, 1)
¡@¡@Brr(Jm, 12 - j * 3 + 3) = Brr(Jm, 12 - j * 3 + 3) + 1
Next j:  Next i
¡@
Set xR = [²Î­p!A2]
xR.Resize(N, 12) = Brr
For j = 1 To 4
¡@¡@xR.Resize(N, 3).Sort Key1:=xR, Order1:=xlAscending, Header:=xlNo
¡@¡@Set xR = xR(1, 4)
Next j
End Sub

°Ñ¦Òªþ¥ó¡G
¤ÀÃþ²Î­pv01.rar (15.77 KB)

¤U¸ü¦¸¼Æ: 30

2015-12-12 11:48

¡@

aa7551

¦^´_ 4# ­ã´£³¡ªL
·PÁ«ü¾É,¤j¤jÁÂÁÂ