前两天，一个朋友问我，有没有办法在excel里实现一个表单里是原始数据，在另一个表单里显示搜索到的行，搜索关键词可用~分隔开，并把搜索历史记录下来？

　　我想了想，用vba实现肯定可以啊，但是我又在想，有没有可能excel自身的功能就可以实现了呢，但是后来没有发现excel自带这种功能。于是思考自己用vba给实现吧。

　　于是我打开我的电脑，结果发现我的office版本是wps，根本就没有vba功能，网上说的使用vba模块安装，但是始终没有安装成功。最后放弃了，自己下载一个office2013, 自带vba功能。

　　其实搜索功能实现思路相当简单，无非就几个循环，把关键词分割出来循环，按行搜索循环，按列搜索循环，然后得到结果后，填充结果，对于历史记录，则需要得到最后一行的行号等。

附件已上传，可点击去下载：  

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作为脚本脚本语言，有其一定的特点，但是做一些小功能还是可以派上用场的。