Excel的VBA：CTRL + F作为Sheet2中宏

Question

此代码搜索数据，如果它发现它在Sheet2上， 它拷贝全行工作表Sheet1上。

我想编辑它： 因此当我搜索例如“John％Wayne” 它寻找包含John和Wayne的字符串的单元格。

Sub myFind() 
'Standard module code, like: Module1. 
'Find my data and list found rows in report! 
Dim rngData As Object 
Dim strDataShtNm$, strReportShtNm$, strMySearch$, strMyCell$ 
Dim lngLstDatCol&, lngLstDatRow&, lngReportLstRow&, lngMyFoundCnt& 

On Error GoTo myEnd 
'******************************************************************************* 
strDataShtNm = "Sheet2" 'This is the name of the sheet that has the data! 
strReportShtNm = "Sheet1" 'This is the name of the report to sheet! 
'******************************************************************************* 
Sheets(strReportShtNm).Select 
Application.ScreenUpdating = False 

'Define data sheet's data range! 
Sheets(strDataShtNm).Select 

With ActiveSheet.UsedRange 
lngLstDatRow = .Rows.Count + .Row - 1 
lngLstDatCol = .Columns.Count + .Column - 1 
End With 

Set rngData = ActiveSheet.Range(Cells(1, 1), Cells(lngLstDatRow, lngLstDatCol)) 

'Get the string to search for! 
strMySearch = InputBox("Enter what to search for, below:" & vbLf & vbLf & _ 
"Note: The search is case sensitive!", _ 
Space(3) & "Find All", _ 
"") 

'Do the search! 
For Each Cell In rngData 
strMyCell = Cell.Value 

'If found then list entire row! 
If strMyCell = strMySearch Then 
lngMyFoundCnt = lngMyFoundCnt + 1 
ActiveSheet.Rows(Cell.Row & ":" & Cell.Row).Copy 

With Sheets(strReportShtNm) 
'Paste found data's row! 
lngReportLstRow = .UsedRange.Rows.Count + .UsedRange.Row 
ActiveSheet.Paste Destination:=.Range("A" & lngReportLstRow).EntireRow 
End With 
End If 
Next Cell 

myEnd: 
'Do clean-up! 
Application.ScreenUpdating = True 
Application.CutCopyMode = False 
Sheets(strReportShtNm).Select 

'If not found then notify! 
If lngMyFoundCnt = 0 Then 
MsgBox """" & strMySearch & """" & Space(3) & "Was not found!", _ 
vbCritical + vbOKOnly, _ 
Space(3) & "Not Found!" 
End If 
End Sub 

Answer 1

您可以使用Find与*通配符（或者，如果你真的想用％，那么在代码*代替％）：

Sub myFind() 

    Dim rToSearch As Range 
    Dim sMySearch As String 
    Dim rFound As Range 
    Dim sFirstAddress As String 
    Dim lLastRow As Long 

    'Get the string to search for! 
    sMySearch = InputBox("Enter what to search for, below:" & vbLf & vbLf & _ 
    "Note: The search is case sensitive!", _ 
    Space(3) & "Find All", _ 
    "") 

    With ThisWorkbook 
     'Set reference to data in column A. 
     With .Worksheets("Sheet2") 
      Set rToSearch = .Range(.Cells(1, 1), .Columns(1).Find("*", , , , xlByColumns, xlPrevious)) 
     End With 
     'Find the last row containing data in Sheet 1. 
     With .Worksheets("Sheet1") 
      On Error Resume Next 
      lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1 
      On Error GoTo 0 
      If lLastRow = 0 Then lLastRow = 1 
     End With 
    End With 

    'Use find to search your text. 
    'FindNext will, strangely enough, find the next occurrence and keep looping until it 
    'reaches the top again - and back to the first found address. 
    With rToSearch 
     Set rFound = .Find(What:=sMySearch, LookIn:=xlValues) 
     If Not rFound Is Nothing Then 
      sFirstAddress = rFound.Address 
      Do 
       rFound.EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Sheet1").Cells(lLastRow, 1) 
       lLastRow = lLastRow + 1 
       Set rFound = .FindNext(rFound) 
      Loop While rFound.Address <> sFirstAddress 
     End If 
    End With 

End Sub