close
標題:
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
其他解答:
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
其他解答:
- 2337旺宏 急救@1@
- 2011年5月16日台北往台東的火車站早上的時間
- LG改字體APP
- i phone 4s 月租問題(台灣大哥大)@1@
- [ 桌上型電腦 ]我要組新電腦請大大們幫忙@1@
- MANY黑色110(第一批)
- youtube影片音樂下載的問題@1@
- 09年高雄百貨公司出清
- [初音]幫我看這首歌的歌名@1@
- GTA5 PC 配備問題@1@
- 2337旺宏 急救@1@
- 2011年5月16日台北往台東的火車站早上的時間
- LG改字體APP
- i phone 4s 月租問題(台灣大哥大)@1@
- [ 桌上型電腦 ]我要組新電腦請大大們幫忙@1@
- MANY黑色110(第一批)
- youtube影片音樂下載的問題@1@
- 09年高雄百貨公司出清
- [初音]幫我看這首歌的歌名@1@
- GTA5 PC 配備問題@1@
此文章來自奇摩知識+如有不便請留言告知
BFC66BE0445C3814
文章標籤
全站熱搜
留言列表
