- ©«¤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½ú
«á¾ÇÂǦ¹©«½Æ²ß×q,¾Ç²ß¤ß±o¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, j%, R&, T$, TT$, xS As Worksheet
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,$¬O¦r¦êÅܼÆ,%¬Oµu¾ã¼Æ,¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = [¤é´Á!A1].CurrentRegion: Set xS = Sheets("´£¨ú¸ê®Æ"): xS.UsedRange.Offset(1).EntireRow.Delete
'¡ô¥OBrrÅܼƬO ¥H¤u§@ªíÀx¦s®æȱa¤Jªº¤Gºû°}¦C,¥OxSÅܼƬO(ª«¥ó)"´£¨ú¸ê®Æ"¤u§@ªí
'¥O¸ê®Æ§R°£,¥u¯d¤U¼ÐÃD¦C
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
T = Brr(i, 8): V = Brr(i, 15): TT = i & "^0*" & Val(V)
'¡ô¥OTÅܼƬOi°j°é¦C8ÄæBrr°}¦CÈ,¥OVÅܼƬOi°j°é¦C15ÄæBrr°}¦CÈ
'¥OTTÅܼƬO°j°é¼Æi ³s±µ"^0*"¦r¦ê,¦A³s±µVÅܼÆÂà¼ÆÈ©Ò²Õ¦¨ªº·s¦r¦ê
If Not Z.EXISTS(T) Then Z(T) = TT Else Z(T) = IIf(Val(V) > Evaluate(Z(T)), TT, Z(T))
'¡ô¦pªGZ¦r¨å¸Ì¨S¦³TÅܼÆkey!´N¥O¥HT¬°key,item¬OTTÅܼƯǤJZ¦r¨å¤¤,
'§_«h´N¥O¥HT¬°key,item¬OIIf()¦^¶ÇÈ
Next
ReDim Arr(1 To UBound(Brr), 1 To UBound(Brr, 2)): Crr = [°Ñ·Ó¼ÆÈ!A1].CurrentRegion
'¡ô«Å§iArrÅܼƬO¤GºûªÅ°}¦C,«Å§i¨ä°}¦C½d³ò,¥OCrr°}¦C¬O ¥H¤u§@ªíÀx¦s®æȱa¤Jªº¤Gºû°}¦C
For i = 2 To UBound(Crr)
'¡ô³]¶¶°j°é!i±q2 ¨ìCrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
T = Crr(i, 1): Crr(i, 1) = ""
'¡ô¥OTÅܼƬOi°j°é¦C1ÄæCrr°}¦CÈ,¥Oi°j°é¦C1ÄæCrr°}¦CȬOªÅ¦r¤¸
If Not Z.EXISTS(T) Then
'¡ô¦pªGZ¦r¨å¸Ì¨S¦³TÅܼÆkey??
Arr(i - 1, 1) = "NA": Crr(i, 1) = "NA": Arr(i - 1, 8) = T
'¡ô¥O§ä¤£¨ìÃöÁä¦r¦Cµù°OÄæ¼g¤J"NA"¦r¦ê
Else
R = Split(Z(T), "^")(0): For j = 1 To UBound(Brr, 2): Arr(i - 1, j) = Brr(R, j): Next
'¡ô¥ORÅܼƬO Z¦r¨å°O¿ýªº¦C¸¹!³]¶¶°j°é±NBrr¸ê®Æ¼g¤JArr°}¦C¸Ì
End If
Next
With Sheets("°Ñ·Ó¼ÆÈ")
.UsedRange.Offset(, 1).EntireColumn.Delete
'¡ô¥O"°Ñ·Ó¼ÆÈ"ªí¥u¯d¤U¼ÐÃDÄæ,¨ä¾lÄæ¦ì§R°£
.[B1].Resize(UBound(Crr)) = Crr: .[B1] = "NAµù°O"
'¡ô¥OBÄæ¼g¤J"NA"µù°O
End With
With xS.[A2].Resize(UBound(Crr) - 1, UBound(Arr, 2))
'¡ô¥H¤U¬OÃö©ó"´£¨ú¸ê®Æ"ªí±q[A2]Àx¦s®æÂX®i«ü©w½d³òÀx¦s®æªºµ{§Ç
.Value = Arr: Application.Goto xS.[A1]
'¡ô¥OArr°}¦Cȼg¤J "´£¨ú¸ê®Æ"ªí,¥O´å¼Ð¸õ¨ì"´£¨ú¸ê®Æ"ªí[A1]Àx¦s®æ
.Columns(2).NumberFormat = "hh:mm:ss"
'¡ô¥O¸Ó½d³ò²Ä2Äæ®æ¦¡¬°2½X®É:¤À:¬í
End With
End Sub |
|