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

[¦r¨åª«¥ó]³æ¤@Äæ¦ìªº­È»P¦h­Ó°}¦C¤ñ¹ï«á¨Ã¤ÀÃþ¦Ü¤£¦PÄæ¦ì

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-10-21 19:53 ½s¿è

¦^´_ 10# greetingsfromtw


¨º¬O¤u§@ªí¡e¨Æ¥ó¡fIJµoµ{¦¡¡A«öAlt + F11¡A¹ï¤u§@ªíª«¥ó«ö¨â¤U

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xR As Range
With Target
¡@¡@If Intersect([J2:L8], .Cells) Is Nothing Then Exit Sub
¡@¡@If .Value = "" Then Exit Sub
¡@¡@Cancel = True
¡@¡@For Each xR In Range([A2], Cells(Rows.Count, 1).End(xlUp))
¡@¡@¡@¡@If InStr(UCase(xR), UCase(.Value)) > 0 Then
¡@¡@¡@¡@¡@Cells(Rows.Count, "G").End(xlUp)(2) = xR
¡@¡@¡@¡@End If
¡@¡@Next
End With
End Sub

TOP

¦^´_ 11# ­ã´£³¡ªL



¤F¸Ñ,¦³¬Ý¨ì¤F,¬O¼g¦b¤u§@ªí¤º,¤£¦n·N«ä,¤p§Ì¦A¬ã¨s¤@¤U.·PÁ«e½ú´£¿ô.

TOP

¦^´_ 9# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×1,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:


°õ¦æµ²ªG:



Sub ex()
[B2:E200].ClearContents
'¡ô²M°£µ²ªGÄæ¸ê®Æ
Set d = CreateObject("Scripting.Dictionary")
'¡ô¥OdÅܼƬO¦r¨å
Set Rng = Range("J1").CurrentRegion.SpecialCells(xlCellTypeConstants)
'¡ô¥ORngÅܼƬO [J1]¦ê¨ÃÁpÀx¦s®æÂX®i½d³òªº«DªÅ¥Õ®æ  ('¤ñ¹ï°}¦C)
For Each a In Range([A2], [A2].End(xlDown))
'¡ô³]³v¶µ°j°é!¥OaÅܼƬOAÄæ¸ÌªºÀx¦s®æ ('­ì©l¸ê®Æ°j°é)
  For Each c In Rng
  '¡ô³]³v¶µ°j°é!¥OcÅܼƬORngÅܼƸ̪ºÀx¦s®æ
     If InStr(UCase(a), UCase(c)) > 0 Then
     '¡ô¦pªGaÅܼÆÀx¦s®æ­ÈÂà´«¦¨­^¤å¤j¼gªº·s¦r¦ê«á,
     '¸Ì­±¦³¥]§t cÅܼÆÀx¦s®æ­ÈÂà´«¦¨­^¤å¤j¼gªº·s¦r¦ê

        d(c.Column) = ""
        '¡ô¥O¥HcÅܼÆÄæ¦ì¼Æ·íkey,item¬OªÅ¦r¤¸,¯Ç¤Jd¦r¨å¸Ì
        '('°O¦í¤ñ¹ï¨ì°}¦CªºÄæ¦ì)

     End If
  Next
  If d.Count > 0 Then
  '¡ô¦pªGd¦r¨åkey¼Æ¶q>0 ?('ªí¥Ü­ì©l¸ê®Æ¤ñ¹ï¦¨¥\)
     For Each ky In d.keys
     '¡ô³]³v¶µ°j°é!¥Oky¬Od¦r¨å¸Ìªº¤@­Ókey
       Cells(65536, ky - 8).End(xlUp).Offset(1, 0) = a
       '¡ô¥Oµ²ªGÄ檺²Ä¤@­ÓªÅ¥Õ®æ¬O aÅܼÆ(Àx¦s®æ­È)
     Next
     d.RemoveAll
     '¡ô²MªÅd¦r¨å
     Else
     Cells(65536, "E").End(xlUp).Offset(1, 0) = a
     '¡ô¤ñ¹ï¤£¦¨¥\!´N±NaÅܼÆ(Àx¦s®æ­È)©ñ¦bEÄæ²Ä¤@­ÓªÅ¥Õ®æ
  End If
Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 9# ­ã´£³¡ªL


    ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½ú¤è®×2(¤£­«½Æ),¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æµ²ªG:



Sub U_Test()
Dim xR As Range, xD, Arr, Brr, Mx&, N%, G(1 To 4), DK
'¡ô«Å§iÅܼÆ
[B2:E200].ClearContents
'¡ô²M°£µ²ªGÄæ¸ê®Æ
Arr = Range([A2], Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArrÅܼƬO¤Gºû°}¦C,¥HAÄæÀx¦s®æ­È(­ì©l¸ê®Æ)±a¤J°}¦C¸Ì
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxDÅܼƬO¦r¨å
For Each xR In [J2:L40]
'¡ô¥O³]³v¶µ°j°é!¥OxR¬O½d³òÀx¦s®æ¸Ìªº¤@®æ
    If xR <> "" Then xD(UCase(xR)) = xR.Column - 9
    '¡ô¦pªGxRÅܼƤ£¬OªÅªº!´N¥O¨äÂà´«¬°¤j¼g­^¤å·íkey,item¬O¨äÄæ¼Æ-9,
    '¯Ç¤JxD¦r¨å¸Ì('ÃöÁä¦r¨Ì¨äÄæ¦ì±a§Ç¸¹)

Next
ReDim Brr(1 To UBound(Arr), 1 To 4)
'¡ô«Å§iBrrÅܼƬO¤GºûªÅ°}¦C,Áa¦V½d³ò¦PArr,¾î¦V±q1 ¨ì4
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é
    N = 4
    '¡ô¥ONÅܼƬO 4 ('¹w³]§Ç¸¹¬°4,¬O¥Î¨Ó©ñ¤£²Å¦Xªº¸ê®Æ)
    For Each DK In xD.keys
    '¡ô³]³v¶µ°j°é!¥ODK¬OxD¦r¨å¸Ìªº¤@­Ókey
        If InStr(UCase(Arr(i, 1)), DK) Then N = xD(DK): Exit For
        '¡ô¦pªG­ì©l¸ê®ÆÂà´«­^¤å¤j¼gªº·s¦r¦ê¸Ì¦³¥]§tDKÅܼÆ!
        '´N¥ONÅܼÆÅÜ§ó¬° ¥HDKÅܼƬdxD¦r¨åªºitem­È('¦³²Å¦X,¨ú¥X§Ç¸¹),
        '¨ú¥X§Ç¸¹«á´Nµ²§ô°j°é,¥Nªí¤£­«½Æ¨Ï¥Î ­ì©l¸ê®Æ

    Next
    G(N) = G(N) + 1
    '¡ô¨Ì§Ç¸¹¤£¦P, ¦U¦Û¦bG³o¤@ºû°}¦C¸Ì ²Ö­pÄæ¦ìªºµ§¼Æ
    If G(N) > Mx Then Mx = G(N)
    '¡ô¨ú±o³Ì¤jµ§¼Æ
    Brr(G(N), N) = Arr(i, 1)
    '¡ô«ö§Ç¸¹¤Îµ§¼Æ¶ñ¤J¸ê®Æ¨ì°}¦C
Next i
[B2].Resize(Mx, 4) = Brr
'¡ô¥O±q[B2]¶}©lÂX®i¦³¸ê®Æªº¦C¼Æ4Äæ,¥HBrr°}¦C­È±a¤J
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤£­n¤p¬Ý¦Û¤v¡A¦]¬°¤H¦³µL­­ªº¥i¯à¡C
ªð¦^¦Cªí ¤W¤@¥DÃD