首页 > 解决方案 > 在 Excel 中同时搜索 (Ctrl + F) 多个单词

问题描述

我正在处理一个 Excel 文件,我有一个需要搜索的单词列表,如果找到它,我必须突出显示它的列。

我想使用 CTRL+F 但我当时只能复制和粘贴一个单词,所以如果有办法通过使用 VBA 或条件格式来自动执行此任务,我就在徘徊。

我在网上查看过,但解决方案并不能很好地解决我的问题。

标签: excelvbaconditional-formatting

解决方案


我在 mrexcel.com 上找到了这个(查找记录并放入摘要表)并快速修改它(感谢 BrianB)。

观察您的选项卡的名称,就像它们在代码中的名称一样。这只是为了帮助快速并向您展示一种方式,它不是很好的编辑或我进一步评论。

Sub FindRecords()
    Dim FromSheet As Worksheet
    Dim FromRow As Long
    Dim ToSheet As Worksheet
    Dim ToRow As Long
    Dim FindThis As Variant
    Dim FoundCell As Object
    '---------------------------------------------------
    Application.Calculation = xlCalculationManual
    Set FromSheet = ThisWorkbook.Worksheets("DataSheet")
    Set ToSheet = ThisWorkbook.Worksheets("Summary")
    ToRow = ThisWorkbook.Worksheets("Summary").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    '---------------------------------------------------
    '- get user input
    FindThis = InputBox("Please enter data to find : ")
    If FindThis = "" Then End ' trap Cancel
    '---------------------------------------------------
    '- clear summary for new data
    'ToSheet.Cells.ClearContents
    '---------------------------------------------------
    ' FIND DATA
    '-
    With FromSheet.Cells
        Set FoundCell = .Find(FindThis, LookIn:=xlValues)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            '------------------------------------------
            '- copy data to summary
            'Do
                FromRow = FoundCell.Row
                ToSheet.Cells(ToRow, 1).Value = _
                        FromSheet.Cells(FromRow, 1).Value
                ToSheet.Cells(ToRow, 2).Value = _
                        FromSheet.Cells(FromRow, 2).Value
                ToSheet.Cells(ToRow, 3).Value = _
                        FromSheet.Cells(FromRow, 3).Value
                ToRow = ToRow + 1
                'Set FoundCell = .FindNext(FoundCell)
            'Loop While Not FoundCell Is Nothing And _
             '   FoundCell.Address <> FirstAddress
            '------------------------------------------
        End If
    End With
    MsgBox ("Done.")
    Application.Calculation = xlCalculationAutomatic
    FindRecords
End Sub

推荐阅读