ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¦^¶Ç¦³­ÈªºÀx¦s®æÀ³¹ï²Ä¤@¦Cªº¸ê®Æ

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ßVBA§ä¥X½d³òÀx¦s®æ¤¤ªº­«½Æ¦C©ÎªÅ¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:


°õ¦æµ²ªG:


Option Explicit
Sub ¿ï¨ú­«½Æ©ÎªÅ¥Õ¦C()
Dim Brr, Z, i&, j%, T$, T1$, xU As Range, C%
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = Range([CQ1], Cells(ActiveSheet.UsedRange.Rows.Count, "A"))
'¡ô¥OBrrÅܼƬO±a¤J«ü©w½d³òÀx¦s®æ­Èªº¤Gºû°}¦C
C = UBound(Brr, 2): T1 = Application.Rept("/", C)
'¡ôCÅܼƬOBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹,¥OT1ÅܼƬOCÅܼƭӳsÄò"/"²Å¸¹ªº¦r¦ê
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   For j = 1 To C: T = T & "/" & Brr(i, j): Next
   '¡ô³]¶¶°j°é!j±q1¨ì CÅܼÆ,¥OTÅܼƬO¥H"/"²Å¸¹³s±µ¦U°j°é°}¦C­Èªº·s¦r¦ê
   If Z(T) <> "" Or T = T1 Then
   '¡ô¦pªG¥HTÅܼƬdZ¦r¨å¦^¶Çitem¤£¬OªÅªº ©ÎTÅܼƦP T1ÅܼÆ?
      If xU Is Nothing Then
      '¡ô¦pªGxUÅܼƬOªÅªº?
         Set xU = Cells(i, 1)
         '¡ô¥OxUÅܼƬO i°j°é¦CAÄæÀx¦s®æ
         Else
         Set xU = Union(xU, Cells(i, 1))
         '¡ô§_«h´N¥O i°j°é¦CAÄæÀx¦s®æ¯Ç¤J xUÅܼƤ¤
      End If
   End If
   Z(T) = 1: T = ""
   '¡ô¥OZ¦r¨å¤¤ key¬°TÅܼƪº item­È¬O1,¥OTÅܼƲMªÅ
Next
If xU Is Nothing Then MsgBox "¨S¦³­«½Æ¦C": Exit Sub
'¡ô¦pªGxUÅܼÆÁÙ¬OªÅªº!´N¸õ¥X´£µøµ¡~~~,¤§«áµ²§ôµ{¦¡°õ¦æ
xU.EntireRow.Select
'¡ô¦pªGxUÅܼƤ£¬OªÅªº!´N±N¨ä©Ò¦bªº¦C¿ï¨ú
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¥¬¬I¦p¼½ºØ¡A¥HÅw³ß¤ß´þ¼íºØ¤l¡A¤~·|µoªÞ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD