在范围中查找单词并将包含单词的单元格插入到列中

我想在单元格范围内find单词，然后复制另一列中包含单词的单元格。
例如单元格的范围是

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 

我想find单词“约翰”，并复制在列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

因为我错过了重复的必要性而编辑。

这工作在我的快速testing。

 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