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

　　前兩天，一個朋友問我，有沒有辦法在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作為腳本腳本語言，有其一定的特點，但是做一些小功能還是可以派上用場的。