让您开始：这是一个通用的 findall 函数，您可以使用它来查找搜索范围内的所有单元格：
Function FindAll(What, _
Optional SearchWhat As Variant, _
Optional LookIn, _
Optional LookAt, _
Optional SearchOrder, _
Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte, _
Optional SearchFormat) As Range
'LookIn can be xlValues or xlFormulas, _
LookAt can be xlWhole or xlPart, _
SearchOrder can be xlByRows or xlByColumns, _
SearchDirection can be xlNext, xlPrevious, _
MatchCase, MatchByte, and SearchFormat can be True or False. _
Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""
Dim SrcRange As Range
If IsMissing(SearchWhat) Then
Set SrcRange = ActiveSheet.UsedRange
ElseIf TypeOf SearchWhat Is Range Then
Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
ElseIf TypeOf SearchWhat Is Worksheet Then
Set SrcRange = SearchWhat.UsedRange
Else: SrcRange = ActiveSheet.UsedRange
End If
If SrcRange Is Nothing Then Exit Function
'get the first matching cell in the range first
With SrcRange.Areas(SrcRange.Areas.Count)
Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
End With
Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If Not CurrRange Is Nothing Then
Set FindAll = CurrRange
Do
Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If CurrRange Is Nothing Then Exit Do
If Application.Intersect(FindAll, CurrRange) Is Nothing Then
Set FindAll = Application.Union(FindAll, CurrRange)
Else: Exit Do
End If
Loop
End If
End Function
找到范围后，您可以遍历范围中的每一行（例如，对于 Rng.Rows 中的每个 rw）并将 A、B 和 C 列中的数据提取到目标工作表。
******编辑******
所以我想我会把代码放在一起，因为提取这些数据有点挑战。我认为以下内容应该适合您...
就目前而言，在工作表 3 的“A1”中输入搜索词，它将使用同一张工作表中从第 2 行开始的数据填充列 B:D。
Sub ExtractData()
Dim wsSrc As Worksheet: Set wsSrc = Worksheets("Sheet1")
Dim wsDest As Worksheet: Set wsDest = Worksheets("Sheet3")
Dim LastRow As Long, RowCounter As Long
Dim SearchRange As Range, FoundRange As Range, rw As Range
Dim Val As String: Val = wsDest.Range("A1")
With wsSrc
LastRow = .UsedRange.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set SearchRange = .Range("AO17", .Cells(LastRow, "AX")) 'AO-AX
Set FoundRange = FindAll(Val, SearchRange)
End With
'Clear Destination Sheet (except header row)
With wsDest
On Error Resume Next
Application.Intersect(wsDest.UsedRange, wsDest.UsedRange.Offset(1, 0)).ClearContents
On Error GoTo 0
End With
' Copy Data
RowCounter = 2
Set FoundRange = Union(FoundRange, FoundRange.EntireRow.Rows) 'Expand Range to entire rows of Range
For Each rw In FoundRange.Rows
wsDest.Cells(RowCounter, 2) = wsSrc.Cells(rw.Row, 1)
wsDest.Cells(RowCounter, 3) = wsSrc.Cells(rw.Row, 2)
wsDest.Cells(RowCounter, 4) = wsSrc.Cells(rw.Row, 3)
RowCounter = RowCounter + 1
Next rw
End Sub
Function FindAll(What, _
Optional SearchWhat As Variant, _
Optional LookIn, _
Optional LookAt, _
Optional SearchOrder, _
Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte, _
Optional SearchFormat) As Range
'LookIn can be xlValues or xlFormulas, _
LookAt can be xlWhole or xlPart, _
SearchOrder can be xlByRows or xlByColumns, _
SearchDirection can be xlNext, xlPrevious, _
MatchCase, MatchByte, and SearchFormat can be True or False. _
Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""
Dim SrcRange As Range
If IsMissing(SearchWhat) Then
Set SrcRange = ActiveSheet.UsedRange
ElseIf TypeOf SearchWhat Is Range Then
Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
ElseIf TypeOf SearchWhat Is Worksheet Then
Set SrcRange = SearchWhat.UsedRange
Else: SrcRange = ActiveSheet.UsedRange
End If
If SrcRange Is Nothing Then Exit Function
'get the first matching cell in the range first
With SrcRange.Areas(SrcRange.Areas.Count)
Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
End With
Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If Not CurrRange Is Nothing Then
Set FindAll = CurrRange
Do
Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If CurrRange Is Nothing Then Exit Do
If Application.Intersect(FindAll, CurrRange) Is Nothing Then
Set FindAll = Application.Union(FindAll, CurrRange)
Else: Exit Do
End If
Loop
End If
End Function