在一个区域中查找一个单词，并将包含该单词的单元格插入列中

Question

我想在一系列单元格中找到一个单词，然后复制另一列中有该单词的单元格
例如，单元格的范围是

          A 
1   john see the man john
2   rain is the friend
3   john can teach
4   learn
5   learning those books
6   fred
7   continuing
8   learn john
9   see top
10  fresh verdic

我想找到单词"john"并复制B列中包含john的单元格：

        B
1  john see the man john
2  john see the man john
3  john can teach
4  learn john

我的代码不起作用。

Sub find()
 Dim m_rnFind As Range
    Dim m_stAddress As String
    'Initialize the Excel objects.
    Set m_wbBook = ThisWorkbook
    Set m_wsSheet = m_wbBook.Worksheets("Book1")
    Set m_rnCheck = m_wsSheet.Range("A1:A10").SpecialCells(xlCellTypeConstants)
    'Retrieve all rows that contain john.  
    With m_rnCheck
        Set m_rnFind = .find(What:="john")
        i = 1
        If Not m_rnFind Is Nothing Then
            m_stAddress = m_rnFind.value
            Cells(i, 2).Value = m_stAddress
            Do
                Set m_rnFind = .FindNext(m_rnFind)
                i = i + 1
            Loop While Not m_rnFind Is Nothing And m_rnFind.Address <> m_stAddress
        End If
    End With
End Sub

Answer 1

由于我错过了重复的必要性而编辑。

这对我的快速测试有效。

Sub find()
  Dim c As Range
  Dim destination As Range
  Dim i As Long
  Const SEARCH_TERM As String = "john"
  Set destination = Range("B1")
  For Each c In Range("A1:A10")
    i = 1
    Do While InStr(i, c.Value, SEARCH_TERM) > 0
        destination.Value = c.Value
        Set destination = destination.Offset(1, 0)
        i = InStr(i, c.Value, SEARCH_TERM) + Len(SEARCH_TERM)
    Loop
  Next
End Sub