[¦r¨åª«¥ó]³æ¤@Äæ¦ìªºÈ»P¦hÓ°}¦C¤ñ¹ï«á¨Ã¤ÀÃþ¦Ü¤£¦PÄæ¦ì
- ©«¤l
- 2831
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2887
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-11-5
|
¥»©«³Ì«á¥Ñ ã´£³¡ª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 |
|
|
|
|
|
|
- ©«¤l
- 45
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 59
- ÂI¦W
- 0
- §@·~¨t²Î
- Win7
- ³nÅ骩¥»
- Office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2014-2-6
- ³Ì«áµn¿ý
- 2019-6-22
|
¦^´_ 11# ã´£³¡ªL
¤F¸Ñ,¦³¬Ý¨ì¤F,¬O¼g¦b¤u§@ªí¤º,¤£¦n·N«ä,¤p§Ì¦A¬ã¨s¤@¤U.·PÁ«e½ú´£¿ô. |
|
|
|
|
|
|
- ©«¤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
|
¦^´_ 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
|
|
|
|
|
- ©«¤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
|
¦^´_ 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
|
|
|
|
|