查找範圍中的單詞並將包含該單詞的單元格插入列

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 

我想找到的單詞「約翰」，並複製那些包含約翰列B細胞：

 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