標題:

EXCEL VBA 關鍵字搜尋 複製並貼上新頁籤

發問:

目前我有一個excel總檔想做出一個按鈕這個巨集在搜尋sheet12的資料時,可以把搜尋結果帶到sheet2sheet1ABCDE1 姓名學校其他2 李曉華政治1233 趙大名台灣4564 師伯光輔仁7895 吳義盧師大45646 張添次東吳5457 詹仁前政治4545按下搜尋鈕後,可以搜尋B欄的關鍵字例如搜尋 "政治"或"政"會直接跳到sheet2,並且呈現ABCDE1... 顯示更多 目前我有一個excel總檔 想做出一個按鈕 這個巨集在搜尋sheet12的資料時,可以把搜尋結果帶到sheet2 sheet1 ABCDE 1 姓名學校其他 2 李曉華政治123 3 趙大名台灣456 4 師伯光輔仁789 5 吳義盧師大4564 6 張添次東吳545 7 詹仁前政治4545 按下搜尋鈕後,可以搜尋B欄的關鍵字 例如搜尋 "政治"或"政" 會直接跳到sheet2,並且呈現 ABCDE 1 李曉華政治123 2 詹仁前政治4545 其中,姓名的部分我會有超連結,所以複製到sheet2時希望也能保持有超連結 如果找不到的話,希望可以有警示字句 其實我有寫了一個類似的巨集,但是我只會把值回傳到sheet2 這個貼在sheet2的值沒辦法保留原始資料上的超連結 請問,有大大可以幫忙解惑嗎???

最佳解答:

[程式碼] Sub matty() Dim Xtext$, i% Sheet2.[A:F].ClearContents Xtext = InputBox("請輸入要搜尋之學校名稱") 2014-12-01 15:04:05 補充: With Sheet1 For i = 1 To .Cells(Rows.Count, 2).End(xlUp).Row Xn = InStr(1, .Cells(i, 2), Xtext) If Xn > 0 Then .Cells(i, 1).Resize(, 10).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1) End If Next End With End Sub 2014-12-01 15:04:42 補充: <<參考檔>>下載地址 http://www.FunP.Net/207093 2014-12-01 15:17:05 補充: 修改檔案,增加如果找不到的話,會出現警示字句! <<參考檔>>下載地址 http://www.FunP.Net/921508 2014-12-01 16:11:51 補充: [程式碼] Sub matty()Dim Xtext$, i%, Xn%, Xm%Sheet2.[A:F].ClearContentsXtext = InputBox("請輸入要搜尋之學校名稱") With Sheet1 Xm = 0 For i = 1 To .Cells(Rows.Count, 2).End(xlUp).Row Xn = InStr(1, .Cells(i, 2), Xtext) '從B欄尋找符合Xtext的值存入Xn的變數 If Xn > 0 Then .Cells(i, 1).Resize(, 10).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1) Xm = Xm + 1 End If Next If Xm = 0 Then MsgBox ("無此資料") End WithEnd Sub <<參考檔>>下載地址 http://www.FunP.Net/921508

其他解答:

aa.jpg

 

此文章來自奇摩知識+如有不便請留言告知

BFC66BE0445C3814
arrow
arrow

    pxrnjl7 發表在 痞客邦 留言(0) 人氣()