Question

此代码搜索Sheet2上的数据，如果它在Sheet2上找到它，它会在Sheet1上复制整行。

我想编辑它：所以当我搜索例如＃34; John％Wayne＆＃34; 它会在其字符串中查找包含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

Excel VBA：CTRL + F作为宏

1 个答案: