excel vba 實現跨表單 搜索-顯示搜索行記錄搜索歷史

前兩天，一個朋友問我，有沒有辦法在excel里實現一個表單里是原始數據，在另一個表單里顯示搜索到的行，搜索關鍵詞可用~分隔開，並把搜索歷史記錄下來？

我想了想，用vba實現肯定可以啊，但是我又在想，有沒有可能excel自身的功能就可以實現了呢，但是後來沒有發現excel自帶這種功能。於是思考自己用vba給實現吧。

於是我打開我的電腦，結果發現我的office版本是wps，根本就沒有vba功能，網上說的使用vba模塊安裝，但是始終沒有安裝成功。最後放棄了，自己下載一個office2013, 自帶vba功能。

其實搜索功能實現思路相當簡單，無非就幾個循環，把關鍵詞分割出來循環，按行搜索循環，按列搜索循環，然後得到結果後，填充結果，對於歷史記錄，則需要得到最後一行的行號等。

附件已上傳，可點擊去下載：跨表單搜索示例-2003.zip

http://files.cnblogs.com/files/yougewe/%E8%B7%A8%E8%A1%A8%E5%8D%95%E6%90%9C%E7%B4%A2%E7%A4%BA%E4%BE%8B-2003.zip

關鍵功能代碼提示：

Sheets("原始數據").Range("A6").CurrentRegion 獲取選擇區域數據 searchArr = Split(searchStr, "~") 分割關鍵詞 Range("A9:V" & Rows.Count).ClearContents 清空原有數據 Sheets("搜索記錄").Range("A65536").End(xlUp).Row 獲取最大行的行號 Sheets("搜索記錄").Range("A" & maxRow).Resize(m, columnCount) = brr 數據填充

實現代碼如下：

Sub 點擊搜索原始數據() Dim i&, j&, m&, c%, t$, columnCount Dim arr, brr(), searchArr() As String, checkedRow() searchStr = InputBox("請輸入要搜索的關鍵詞，多個關鍵詞以~分隔", "搜索數據選項", "雲~餐") If searchStr = "" Then MsgBox ("no search str ...") Exit Sub End If searchArr = Split(searchStr, "~") arr = Sheets("原始數據").Range("A6").CurrentRegion columnCount = UBound(arr, 2) rowCounts = UBound(arr) searchArrCount = UBound(searchArr) ReDim brr(1 To UBound(arr), 0 To columnCount) ReDim checkedRow(1 To rowCounts) Range("A9:V" & Rows.Count).ClearContents startRowNum = 6 For i = startRowNum To rowCounts If (checkedRow(i) 1) Then 因為當搜索到結果後會把整行顯示出來，因此只要搜索到一行後，後續就可以不再搜索該行了，避免重複，也提升效率 For iColumnNum = 1 To columnCount findStr = 0 For iSearchNum = 0 To searchArrCount If arr(i, iColumnNum) Like "*" & searchArr(iSearchNum) & "*" Then m = m + 1 checkedRow(i) = 1 findStr = 1 Exit For End If Next If findStr = 1 Then For j = 0 To columnCount - 1 brr(m, j) = arr(i, j + 1) 按行進行數據填充 Next End If Next End If Next maxRow = Sheets("搜索記錄").Range("A65536").End(xlUp).Row + 3 查找最大行數 If m > 0 Then cc = UBound(brr, 1) cc2 = UBound(brr, 2) Sheets("搜索").Range("A9").Resize(m, columnCount) = brr Sheets("搜索記錄").Cells(maxRow - 1, 1) = "本次搜索：" & searchStr & " 搜索時間：" & Now() Sheets("搜索記錄").Range("A" & maxRow).Resize(m, columnCount) = brr Else Sheets("搜索記錄").Cells(maxRow - 1, 1) = "本次搜索：" & searchStr & " 搜索時間：" & Now() Sheets("搜索記錄").Cells(maxRow, 1) = "沒有搜索到結果" End If 不管有無結果都需要記錄操作 End Sub

注意的點： 使用office2013編輯生成了vba程序後，保存為2013的格式，下次打開後，該宏代碼就丟失了，這是殘酷的事實。解決辦法為：保存為2003格式就可以了。

vb作為腳本腳本語言，有其一定的特點，但是做一些小功能還是可以派上用場的。

喜歡這篇文章嗎？立刻分享出去讓更多人知道吧！