- ©«¤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½ú
«á¾Ç§ïÅܻݨD±¡¹Ò,ÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, N&, i&, j&
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([C1], [A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HA~CÄæ¸ê®Æ±a¤J
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é
If Y(Brr(i, 3)) = "" Then N = N + 1: Y(Brr(i, 3)) = N
'¡ô¥O¥H¦r¨å¬ö¿ý¯Z§O¦bµ²ªG°}¦CCrrªºÄæ¦ì
Next
ReDim Crr(1 To UBound(Brr), 1 To 2 + N)
'¡ô«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V±q1¨ì(2+N)
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
Crr(i, 1) = Brr(i, 1): Crr(i, 2) = Brr(i, 2)
'¡ô¥O¤é´Á±a¤JCrr²Ä1Äæ,'¡ô¥O®É¶¡±a¤JCrr²Ä2Äæ
If i = 1 Then
'¡ô¦pªG¬OBrr²Ä1¦C!´N§â¯Z§O¼ÐÃD¦C¼g¤JCrr°}¦C²Ä1¦C
For j = 1 To N: Crr(1, j + 2) = Y.KEYS()(j - 1): Next
GoTo i01
'¡ô¼ÐÃD¦C³B²z§¹,¤£¥²³B²z«áÄò²Ó¸`,©Ò¥H¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ
End If
Crr(i, Y(Brr(i, 3)) + 2) = "V"
'¡ô¥OCrr°}¦C¥¿½T¯Z§O¦ì¸mÄæ¼g¤J "V"
i01: Next
With [E1].Resize(UBound(Crr), 2 + N)
.EntireColumn.Clear
'¡ô¥Oµ²ªGÄæ¸ê®Æ¾ãÄæ²M°£
.Value = Crr
'¡ô¥O¥HCrr°}¦CȶK¤J³oWithªº½d³ò
Intersect(.Cells, [E:E]).NumberFormatLocal = "yyyy/m/d"
Intersect(.Cells, [F:F]).NumberFormatLocal = "hh:mm:ss"
.Borders.LineStyle = 1
.EntireColumn.AutoFit
'¡ô³B²z®æ¦¡
End With
Set Y = Nothing: Erase Brr, Crr
'¡ôÄÀ©ñÅܼÆ
End Sub |
|