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

[µo°Ý] ½Ð±ÐÃö©ó¸ê®Æ¤ñ¹ï«á¤§¤£­«½Æªº¼Æ¶q

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ßVBA°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Y, x, A, N%, i&
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([B2], [A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   A = Split(Replace(Brr(i, 2), " ", "") & ";", ";")
   '¡ô¥OAÅܼƬO¤@ºû°}¦C,¥H";"¦r¤¸¤À³Î¦r¦ê±a¤J
   For Each x In A
   '¡ô³]³v¶µ°j°é!xÅܼƬOA¤@ºû°}¦C¸Ìªº°}¦C¤l
      If x <> "" Then
      '¡ô¦pªGxÅܼƤ£¬OªÅ¦r¤¸?
         Y(x) = ""
         '¡ô¥OxÅܼƬOkey,item¬OªÅ¦r¤¸,¯Ç¤JY¦r¨å¸Ì(Âo­«½Æ)
         N = N + 1
         '¡ô¥ONÅܼƲ֥[1 (²Ö¥[°ê¼Æ)
      End If
   Next
   Brr(i, 1) = N: N = 0
   '¡ô¥O­ì°}¦C¦ì¸m²Ä1Äæ¼g¤JNÅܼÆ(°ê¼Æ),¥ONÅܼÆÂk¹s(¦]¬°¤U­Ó°j°é­n¥Î¦¹ÅܼÆ)
   Brr(i, 2) = IIf(Y.Count > 1, Y.Count, 0)
   '¡ô¥O­ì°}¦C¦ì¸m²Ä2Äæ¼g¤J ¸ó°ê¼Æ
   Y.RemoveAll
   '¡ô¥O²MªÅY¦r¨å
Next
[D1:E1] = [{"°ê§O¼Æ","¸ó°ê¼Æ"}]
'¡ô¥OÀx¦s®æ¼g¤J¼ÐÃD¦C
[D2].Resize(UBound(Brr), 2) = Brr
'¡ô¥OBrr°}¦C­È±q[D2]¶}©l±a¤JÀx¦s®æ
Set Y = Nothing: Erase Brr, A
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i»X½ªªº¦Û¥Ñ¡j¤H±`¦b¤°»ò³£¥i¥H¦Û¥Ñ¦Û¦bªº®É­Ô¡A«o³Q³oºØÀH¤ß©Ò±ýªº¦Û¥Ñ»X½ª¡AµêÂY®É¥ú¦Ó²@µLıª¾¡C
ªð¦^¦Cªí ¤W¤@¥DÃD