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

[µo°Ý] ½Ð±Ð°ê§Oµ§¼Æ¤§­pºâ

¦^´_ 10# °¶ÔÐ
³o¤½¦¡½T¹ê¦³º|¬}
¦pªGDÄ檺°ê§O¦bAÄ椣¥u¥X²{¤@¦¸´N¥X¿ù¤F
¦A·Q·Q¬Ý°£¤FVBAÁÙ¦³¨ä¥L¬Æ»ò¤èªk¥i¥H§¹¥þ¤ñ¹ï
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

§Ú¼g¤£¥X³o­Ó¤½¦¡¡A·Pıvbaªº¦r¨å¬d¸ß¤~¬O³Ì¦nªº¿ìªk¡C
­Y¤£·Q¥Îvba¡A¥ý­åªR¦A¥Îcountif±o¤F¡I

TOP

¦^´_  °¶ÔÐ
³o¤½¦¡½T¹ê¦³º|¬}
¦pªGDÄ檺°ê§O¦bAÄ椣¥u¥X²{¤@¦¸´N¥X¿ù¤F
¦A·Q·Q¬Ý°£¤FVBAÁÙ¦³¨ä¥L¬Æ»ò¤è ...
Hsieh µoªí©ó 2010-10-2 16:26



¸Õ¸Õ
E2
=SUMPRODUCT((ISNUMBER(FIND(";"&SUBSTITUTE(D2," ","")&";",";"&SUBSTITUTE($A$2:$A$75," ","")&";"))*1))
1

µû¤À¤H¼Æ

    • Hsieh: «Ü¦nªº¤½¦¡ª÷¿ú + 2
¾÷¾¹¤H¤T¤j©w«ß-«OÅ@¤HÃþ¡BªA±q©R¥O¡B«OÅ@¦Û¤v
§Úªº¤T¤j©w«ß-¥Í©R¡B¥Í¦s¡B¥Í¬¡

TOP

991002-1.rar (12.95 KB)
©w¸q¦WºÙx=OFFSET(Sheet2!$A$1,,,COUNTA(Sheet2!$A:$A))
°}¦C¤½¦¡{=SUM(IF((LEFT(SUBSTITUTE(x,D2,""))=";")+(RIGHT(SUBSTITUTE(x,D2,""),2)="; ")+(ISNUMBER(FIND("; ;",(SUBSTITUTE(x,D2,"")))))+(SUBSTITUTE(x,D2,"")=""),1,0))}
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

ÁÂÁÂ[asimov]»P[Hsieh]ª©¥D
­«½Æ­pºâªº°ÝÃD¸Ñ¨M¤F,ÁÂÁÂ!
°¶Ôйq¤l®Ñ,Åwªï§K¶O¤U¸ü°Ñ¦Ò
http://www.twbts.com/ebook/?subject=office
http://www.twbts.com/ebook/?subject=soft
°¶ÔÐÂîѮw---https://www.facebook.com/groups/669579416484096/
¦³¤@®a¬a¥J©±---https://www.facebook.com/sadodona

TOP

¦^´_ 14# Hsieh


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

°õ¦æ«e:


°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Brr, i&, S&, T, V, Y, Z
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([A2], Cells(Rows.Count, 1).End(3)): T = "; "
For i = 1 To UBound(Brr)
   For Each V In Split(Brr(i, 1), T)
      If InStr(Z, "/" & V & "/") = 0 And V <> "" Then
         Z = Z & "/" & V & "/": Y(V) = Y(V) + 1: S = S + 1
      End If
   Next
   Z = ""
Next
[J:K].ClearContents: [J1] = [A1]: [K1] = "°ê§O¼Æ(¨C®æ¤£­«½Æ²Î­p)"
[J2].Resize(Y.Count, 1) = Application.Transpose(Y.keys)
[K2].Resize(Y.Count, 1) = Application.Transpose(Y.items)
With [J2].Resize(Y.Count, 2)
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2
   .EntireColumn.AutoFit
End With
MsgBox S
Set Y = Nothing: Set Brr = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-29 15:29 ½s¿è

¦^´_ 14# Hsieh


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾Ç½m²ß:
1.§ì¨ú¸ê®Æ¦C2­¿ªº°}¦C
2.¦P¤@°}¦C«e¬q¬O­ì©l¸ê®Æ,«á¬q©ñµ²ªG¸ê®Æ
3.¦A±N«e¬q­ì©l¸ê®Æ²M°£
4.¶¶±Æ§Ç±Nµ²ªG¸ê®Æ«e®¿
5.¥Î¦r¨å²£¥ÍÅܼÆ
½Ð«e½ú­Ì«ü±Ð

Option Explicit
Sub TEST_2()
Dim Brr, V, Y, i&, N&, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
N = Cells(Rows.Count, 1).End(3).Row
Set xR = Range([B1], Cells(N * 2, 1))
Brr = xR: Y(0) = N: Y(2) = "; "
For i = 2 To UBound(Brr) / 2
   For Each V In Split(Brr(i, 1), Y(2))
      If InStr(Y(3), "/" & V & "/") = 0 And V <> "" Then
         Y(3) = Y(3) & "/" & V & "/": Y(1) = Y(1) + 1
         If Y(V) = "" Then
            Y(0) = Y(0) + 1: Y(V) = Y(0)
            Brr(Y(0), 1) = V: Brr(Y(0), 2) = 1
            Else
              Brr(Y(V), 2) = Brr(Y(V), 2) + 1
         End If
      End If
   Next
   Y(3) = ""
Next
With [J1].Resize(UBound(Brr), 2)
   .EntireColumn.ClearContents
   .Value = Brr
   Intersect(Rows("1:" & N), .Cells).ClearContents
   .Item(1) = "°ê§O": .Item(2) = "°ê§O¼Æ(¨C®æ¤£­«½Æ²Î­p)"
   .Sort KEY1:=.Item(1), Order1:=1, Header:=1
   .EntireColumn.AutoFit
End With
MsgBox Y(1)
Set Y = Nothing: Set Brr = Nothing: Set xR = Nothing
End Sub
=========================================
¸É¥R:
§Ñ¤F¦Ò¼{¨ì°ê§O¼Æ¦pªG¤ñ­ì¸ê®Æ¦C¦h´N·|¿ù»~,2­¿³ô¼{!¦¹ªk¤£¦n
=========================================

Option Explicit
Sub TEST_3()
Dim Arr, Brr, V, Y, i&, N&, xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B1], Cells(Rows.Count, 1).End(3))
Brr = xR: Y(2) = "; "
ReDim Arr(1 To 10000, 1 To 2)
For i = 2 To UBound(Brr)
   For Each V In Split(Brr(i, 1), Y(2))
      If InStr(Y(3), "/" & V & "/") = 0 And V <> "" Then
         Y(3) = Y(3) & "/" & V & "/": Y(1) = Y(1) + 1
         If Y(V) = "" Then
            Y(0) = Y(0) + 1: Y(V) = Y(0)
            Arr(Y(0), 1) = V: Arr(Y(0), 2) = 1
            Else
              Arr(Y(V), 2) = Arr(Y(V), 2) + 1
         End If
      End If
   Next
   Y(3) = ""
Next
With [J2].Resize(Y(0), 2)
   .EntireColumn.ClearContents
   .Value = Arr
   .Item(0, 1) = "°ê§O": .Item(0, 2) = "°ê§O¼Æ(¨C®æ¤£­«½Æ²Î­p)"
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2
   .EntireColumn.AutoFit
End With
MsgBox Y(1)
Set Y = Nothing: Set Brr = Nothing: Set xR = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤H¨ÆªºÁ}Ãø»PµZ¿i¡A´N¬O¤@ºØ¦ÒÅç¡C
ªð¦^¦Cªí ¤W¤@¥DÃD