excel - VBA循环工作表以查找单词的多个实例

Question

我正在尝试为 excel 编写一个宏搜索 Sheet1 和

• 查找单词 Force 和 Grade 的所有实例，然后
• 复制这些单词下方的单元格(所有单元格到第一个空行)，然后粘贴到 Sheet2。

这些词(Force 和 Grade)可以在 Worksheet1 的任何单元格中找到，并且每次创建文件时使用区域的大小都会发生变化。

到目前为止，我只能让它找到每个单词的第一个实例。我已经尝试了本网站和其他网站上的示例中的多种类型的循环。

我觉得这应该很简单，所以我不确定为什么我找不到解决方案。我尝试过以 For i To ws.Columns.Count 开头的 For Next 循环(其中“ws”设置为 Sheet1)，但它变成了无限循环(尽管总列数仅为15 左右)。任何帮助或插入正确的方向将不胜感激。

这是迄今为止有效的代码:

我的代码

'COPY AND PASTE ALL FORCE VALUES TO FROM SHEET1 TO SHEET2
Sheets("Sheet1").Select
Cells.Find(What:=strSearch1, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Activate   'select cell below the word "Force"
Range(ActiveCell, ActiveCell.End(xlDown)).Select    'select all cells after "Force" to first empty cell
numBonds = Range(ActiveCell, ActiveCell.End(xlDown)).Count
Selection.Copy
Sheets("Sheet2").Select
Cells(Selection.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Select 'paste to next column
ActiveSheet.Paste

Answer 1

您应该使用FindNext来识别所有匹配项。像这样将 Force 所有实例下方的所有单元格复制到 Sheet2 的 A 列

Dim StrSearch As String
Dim rng1 As Range
Dim rng2 As Range

StrSearch = "Force"

With Worksheets(1).UsedRange
    Set rng1 = .Find(StrSearch, , xlValues, xlPart)
    If Not rng1 Is Nothing Then
        strAddress = rng1.Address
        Set rng2 = rng1
        Do
            Set rng1 = .FindNext(rng1)
            Set rng2 = Union(rng2, rng1)
        Loop While Not rng1 Is Nothing And rng1.Address <> strAddress
    End If
End With

If Not rng2 Is Nothing Then
For Each rng3 In rng2
Range(rng2.Offset(1, 0), rng3.End(xlDown)).Copy Sheets(2).Cells(Rows.Count, "A").End(xlUp)
Next
End If