- ©«¤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-10-21
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½Æ²ßª½¦¡§e²{¤è¦¡,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 2), A, Y, R&, i&, TT$, T1$, T3$, T4 As Date, T9$
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([sheet1!I3], [sheet1!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥Hsheet1 ªíªºA~IÄæÀx¦s®æȱa¤J°}¦C¤¤
With Sheets("¤u§@ªí1").[A2].Resize(UBound(Brr), UBound(Brr, 2))
'¡ô¥H¤U¬OÃö©ó¦W¬° "¤u§@ªí1" ¤u§@ªíÂX®iBrr°}¦C½d³òªºµ{§Ç
.Value = Brr
'¡ô¥OÀx¦s®æȬO Brr°}¦CÈ
.Sort KEY1:=.Item(1), Order1:=1, _
Key2:=.Item(4), Order2:=1, Header:=2
'¡ô¥O¸Ó½d³ò°µ2¼h¦¸,µL¼ÐÃD¦CªºÁa¦V¶¶±Æ§Ç
Brr = .Value
'¡ô¥OBrr¤Gºû°}¦CȬO¸Ó½d³ò±Æ§Ç«áªº°}¦CÈ
End With
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
T1 = Brr(i, 1): T3 = Brr(i, 3): T4 = Brr(i, 4): T9 = Brr(i, 9)
'¡ô¥OÅܼƸˤJ°}¦CÈ,¤@¤è±©w¸q¨äÈ,¤@¤è±¥i¥HÁYµuµ{¦¡½X
If T9 <> "°ê°²" Then GoTo i00
'¡ô¦pªGT9ÅܼƤ£¬O "°ê°²"¦r¦ê,´N¸õ¨ìi00¦ì¸mÄ~Äò°õ¦æ
TT = T1 & "|" & T3: A = Y(TT)
'¡ô¥OTTÅܼƬO ²Õ¦X¦r¦ê,¥OAÅܼƬO ¥HTTÅܼƬdY¦r¨å¦^¶Çªºitem
If Not IsArray(A) Then A = Crr: Y(TT & "/½s") = T1: Y(TT & "/¦W") = T3
'¡ô¦pªGitem¤£¬O°}¦C?? ´N¥OAÅܼƬOCrr°}¦C(ªÅ°}¦C),
'¥OTTÅܼƳs±µ "/½s"²Õ¦¨ªº·s¦r¦ê·íkey,item¬OT1ÅܼÆ,¯Ç¤JY¦r¨å¸Ì,
'¥OTTÅܼƳs±µ "/¦W"²Õ¦¨ªº·s¦r¦ê·íkey,item¬OT3ÅܼÆ,¯Ç¤JY¦r¨å¸Ì
R = Y(TT & "/R"): R = R + 1: Y(TT & "/R") = R
'¡ô¥ORÅܼƬO TTÅܼƳs±µ "/R"²Õ¦¨ªº·s¦r¦ê¬dY¦r¨åªº¦^¶ÇÈ,
'¥ORÅܼƲ֥[ 1,
'¥OTTÅܼƳs±µ "/R"²Õ¦¨ªº·s¦r¦ê·íkey,item¬O RÅܼÆ,¯Ç¤JY¦r¨å¸Ì
A(R, 1) = T4: A(R, 2) = T9: Y(TT) = A
'¡ô¥ORÅܼƦC²Ä1ÄæA°}¦CȬO T4ÅܼÆÈ,¥ORÅܼƦC²Ä2ÄæA°}¦CȬO T4ÅܼÆÈ,
'¥OTTÅܼƷíkey,item¬OA¤Gºû°}¦C¯Ç¤JY¦r¨å¤¤
i00: Next
With Sheets("¤u§@ªí1")
'¡ô¥H¤U¬OÃö©ó¦W¬° "¤u§@ªí1" ¤u§@ªíªºµ{§Ç
.UsedRange.Offset(1, 0).Clear: R = 1
'¡ô¥O¨Ï¥ÎªºÀx¦s®æ©¹¤U°¾²¾1¦C½d³òªºÀx¦s®æ²M°£,¥ORÅܼƬO 1
.Columns(1).NumberFormatLocal = "@"
'¡ô¥OAÄæ®æ¦¡¬O ¤å¦r
For Each A In Y.KEYS
'¡ô³]³v¶µ°j°é,¥OAÅܼƬOY¦r¨å¸Ìªºkey
If Not IsArray(Y(A)) Then GoTo i01
'¡ô¦pªG¥HAÅܼƬdY¦r¨å¦^¶Ç±oitem¤£¬O °}¦C,´N¸õ¨ìi01¦ì¸m°õ¦æ
R = R + 1
'¡ô¥ORÅܼƲ֥[1
.Cells(R, 1) = Y(A & "/½s"): .Cells(R, 2) = Y(A & "/¦W")
'¡ô¥OÀx¦s®æ¼g¤J û¤u½s¸¹»P©m¦W
.Cells(R, 3).Resize(Y(A & "/R"), 2) = Y(A): R = R + Y(A & "/R") - 1
'¡ô¥O¾A·í½d³ò¼g¤JY¦r¨å©Ò¦^¶Çitem¤Gºû°}¦CÈ
i01: Next
End With
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub |
|