Hsieh

¦^´_ 1# gameshop

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. d1("¸s²Õ") = Array("¸s²Õ", "¤é´Á", "¼Æ­È")
   
5. With Sheets(1)
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown))
   
7.    s = Date - a.Offset(, 1)
   
8.    d(a.Value) = IIf(IsEmpty(d(a.Value)), s, d(a.Value))
   
9.    If s > 0 And d(a.Value) > s Then
   
10.          d(a.Value) = s
    
11.          d1(a.Value) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value)
    
12.    End If
    
13. Next
    
14. End With
    
15. Sheets(2).[E1].Resize(d1.Count, 3) = Application.Transpose(Application.Transpose(d1.items))
    
16. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 5# gameshop

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary") '³Ð«Ø¦r¨åª«¥ó¬ö¿ý¸s²Õ¤é´Á®t
   
3. Set d1 = CreateObject("Scripting.Dictionary") '³Ð«Ø¦r¨åª«¥ó¬ö¿ý¸s²Õ³Ì¤p¤é´Á®t
   
4. 
   
5. With Sheets(1) '¸ê®Æ¤u§@ªí
   
6. ar = .Range("A1").CurrentRegion '¸ê®Æ©Ò¦³½d³ò°O¿ý¨ì°}¦C
   
7. d1(ar(1, 1)) = Application.Index(ar, 1) '«Ø¥ß¼ÐÃD¦C
   
8.   For i = 2 To UBound(ar, 1) '±q²Ä2¦C¶}©l°j°é
   
9.   s = Date - ar(i, 2) '¤é´Á®t
   
10.   If s >= 0 Then '¤é´Á®t¬°¥¿­È
    
11.      If IsEmpty(d(ar(i, 1))) Then d(ar(i, 1)) = s '°²¦p¸s²ÕÁÙ¨S¸ê®Æ¡A´N±N¤é´Á®t¥[¤J¸s²Õ
    
12.      If s <= d(ar(i, 1)) Then d(ar(i, 1)) = s: d1(ar(i, 1)) = Application.Index(ar, i) '¤ñ¸û¤é´Á®t«á°O¿ý¸Ó¦C¸ê®Æ¨ì¦r¨å¹ïÀ³¸s²Õ¤º
    
13.   End If
    
14.   Next
    
15. End With
    
16. Sheets(2).Range("A1").CurrentRegion.ClearContents '²M°£Â¦³¸ê®Æ
    
17. Sheets(2).[A1].Resize(d1.Count, UBound(ar, 2)) = Application.Transpose(Application.Transpose(d1.items)) '¼g¤J¸ê®Æ
    
18. End Sub

½Æ»s¥N½X