­ã´£³¡ªL

Sub test()
Dim xF As Range, Shp As Shape, T$
[F:G].Clear
Set Shp = ActiveSheet.Shapes(Application.Caller)
T = Replace(Shp.TextFrame.Characters.Text, Chr(10), "")
Set xF = [¤u§@ªí2!1:1].Find(T, Lookat:=xlWhole)
If xF Is Nothing Then MsgBox "§ä¤£¨ì¡e" & T & "¡fÂd¦ì¸ê®Æ¡I": Exit Sub
Range(xF, xF(65000, 1).End(xlUp)(1, 2)).Copy [F1]
End Sub

Xl0000095.rar (15.68 KB)

¤U¸ü¦¸¼Æ: 25

2016-8-23 13:04

­ã´£³¡ªL

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

«D±`·PÁ¤j¤j
³o¬O§Ú³Ìªì·Q­nªº§e²{¤è¦¡©O

¥i¬O§Ú¦b¸ê®Æªí2·s¼W¸ê®ÆÂd®É   §Ú¦b¸ê ...
prince0413 µoªí©ó 2016-8-23 13:53

¡e«ö¶s¡fª«¥óªº¡e¦WºÙ¡f¤Îªí­±¤å¦r³£­n§ï¡A­Y¥Î½Æ»sªº¡A·sªº¦WºÙ·|¤@¼Ë¡A¨Ò¦p¡e¯x§Î¢°¡f¡A­n§ï¦¨¨ä¥¦¡I
¥tÂd¦ì­n¥H¼Æ¦r©Î­^¤å¦r°Ï¤À¡A¨Ò¦p¡e°Ó«~ÂdA¡f¡e°Ó«~ÂdB¡f

­ã´£³¡ªL

¦^´_ 13# prince0413


   

¤U¸ü (17.54 KB)

2016-8-23 15:34

¦b¶ê®Ø¦ì¸m(¦ì§}¦C), ­×§ï§¹ª½±µ«öEnter, °O±o¦WºÙ¤¤¶¡¤£­n¯dªÅ¥Õ®æ~~

­ã´£³¡ªL

¦^´_ 18# prince0413



[A:B].Clear

Range(xF, xF(65000, 1).End(xlUp)(1, 2)).Copy [A1]