Найти слово в ячейке

Question

Excel - VBA Мне было интересно, как найти слово в диапазоне строк Excel, используя VBA. Ex. «слово, которое нужно найти», это не только значение ячейки, но и слово в строке. Например, способ найти слово «сеть» в строке «Нужна помощь для сопоставления сетевого принтера».

Sub SearchForSfb() 

    Dim LSearchRow As Integer 
    Dim LCopyToRow As Integer 

    On Error GoTo Err_Execute 

    'Start search in row 1 
    LSearchRow = 1 

    'Start copying data to row 2 in Open (row counter variable) 
    LCopyToRow = 2 

    While Len(Range("E" & CStr(LSearchRow)).Value) > 0 

     'If value in column E = "word to be found", copy entire row to Open 
     If Range("E" & CStr(LSearchRow)).Value = "word to be found" Then 

     'Select row in Data to copy 
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
     Selection.Copy 

     'Paste row into SFB in next row 
     Sheets("SFB").Select 
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
     Sheets("SFB").Paste 

     'Move counter to next row 
     LCopyToRow = LCopyToRow + 1 

     'Go back to Data to continue searching 
     Sheets("Data").Select 

     End If 

     LSearchRow = LSearchRow + 1 

    Wend 

    'Position on cell A3 
    Application.CutCopyMode = False 
    Range("A3").Select 

    MsgBox "All matching data has been copied." 

    Exit Sub 

Err_Execute: 
    MsgBox "An error occurred." 

End Sub 

Answer 1

Используйте простой цикл

Sub Button1_Click() 
    Dim ws As Worksheet 
    Dim sh As Worksheet 
    Dim lstRw As Long 
    Dim rng As Range 
    Dim s As String 
    Dim c As Range 

    s = "* network *" 

    Set ws = Sheets("Data") 
    Set sh = Sheets("SFB") 

    With ws 
     lstRw = .Cells(.Rows.Count, "E").End(xlUp).Row 
     Set rng = .Range("E2:E" & lstRw) 
    End With 

    For Each c In rng.Cells 
     If c.Value Like s Then 
      c.EntireRow.Copy sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1) 
     End If 
    Next c 


End Sub 

Или вы можете использовать фильтр макро

Sub FiltExample() 
    Dim ws As Worksheet, sh As Worksheet 
    Dim rws As Long, rng As Range 
    Set ws = Sheets("Data") 
    Set sh = Sheets("SFB") 

    Application.ScreenUpdating = 0 

    With ws 
     rws = .Cells(.Rows.Count, "E").End(xlUp).Row 
     .Range("E:E").AutoFilter Field:=1, Criteria1:="=*network*" 
     Set rng = .Range("A2:Z" & rws).SpecialCells(xlCellTypeVisible) 
     rng.EntireRow.Copy sh.Cells(sh.Rows.Count, "A").End(xlUp).Offset(1) 
     .AutoFilterMode = False 
    End With 

End Sub