Excel VBA 查找包含文本（部分匹配）和 return 整行的所有单元格

Question

我在 'Sheet1' 上有一个很大的 table，有数千行和多列。

我想包括一个搜索功能（类似于 Excel 的内置查找所有搜索，遍历整个 'Sheet1' 和 returns 所有行，其中找到部分匹配项（在任何列中）。

然后我希望将所有这些行复制到文档中的另一个 sheet。前几行（包括搜索框）中已经有一些数据。

I'm using cyberponks find all function (see below)但显然不知道如何正确使用它

Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
Dim SearchResult As Range
Dim firstMatch As String
With rng
    Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    If Not SearchResult Is Nothing Then
        firstMatch = SearchResult.Address
        Do
            If FindAll Is Nothing Then
                Set FindAll = SearchResult
            Else
                Set FindAll = Union(FindAll, SearchResult)
            End If
            Set SearchResult = .FindNext(SearchResult)
        Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
    End If
End With
End Function

这是我到目前为止想出的代码

Sub Search_Button1_Click()

Dim FindWhat As String
Dim foundCells As Range
Set lblActiveX = Sheet2.Shapes("TextBox1").OLEFormat.Object
FindWhat = lblActiveX.Object.Value
Set foundCells = FindAll(Sheet1.UsedRange, FindWhat) 
        If foundCells Is Nothing Then
            Msgbox ("Value Not Found")
        Else
            For Each cell In foundCells
                cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("B9" & Rows.Count).End(xlUp).Offset(1)
            Next
        End If
End Sub

问题是

不return部分匹配
如果在一行中多次找到一个搜索词，它会复制同一行，次数与该词出现的次数相同。

我需要能够在每一列中进行搜索，但如果找到任何匹配项，我只需要该行一次。

我确实有一个唯一的 ID 列“A”，但不确定我是否应该将它用于 return 每行一次。

如果输入更多单词，我完全不知道如何找到匹配项。

例如，如果输入以下三个词“无焦虑抑郁症”，我希望return编辑的行在“B”列中包含“抑郁症”，在“列”中包含“焦虑” C" 和 D 列中的 "free"。这些词中的 None 只会单独出现，但会出现在一个句子或列表的一部分中，用逗号分隔。他们的顺序也不同。

如有任何帮助，我们将不胜感激。

Answer 1

1.The XlLookAt参数可以设置为xlPart以获得部分匹配

2.Assuming 从 Findall() 返回的范围内的单元格与作为 rng 参数传递给 [=12] 的范围内的单元格的顺序相同=]，当您遍历 foundCells 中的每个单元格时，将 cell.row 存储到某个变量 lastfoundrow 中。然后对于下一个 cell 仅复制该行 if cell.row <> lastfoundrow:

'init as zero so it will not match cell.row the first time (row cannot be 0)
lastfoundrow = 0

For Each cell In foundCells
    If cell.row <> lastfoundrow then
        cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("B9" & Rows.Count).End(xlUp).Offset(1)

        ' only store *after* we have compared cell.row to lastfoundrow above
        lastfoundrow = cell.row
    End If
Next

如果该单元格与最后找到的单元格位于同一行，则它应该跳过该单元格。

3.Not当然我明白这一点。

Excel VBA 查找包含文本（部分匹配）和 return 整行的所有单元格

Excel VBA Find all cells containing text (partial match) and return entire row

excel

vba

search

copy-paste