查找并 select 工作表中的所有匹配项
Find and select all matches in worksheet
大家好，我正在尝试创建一个按钮，它会根据我在单元格 E2 中输入的值，select 全部匹配。它的工作方式有点像 Ctrl + Find 功能，如果我在 E2 中输入 doggo，它将搜索我指定的范围并转到带有 doggo 的第一个单元格，下一次单击按钮时它将转到下一个单元格与狗狗。我在网上研究后得到了这段代码，但它只进入最后一个带有 doggo 的单元格，并且不会从第一个到最后一个循环（例如，如果不同单元格中有三个 doggo，任何人都可以协助突出显示什么是什么与代码？
Sub Button4_Click()
Dim FindValue As String
FindValue = Range("E2")
Dim Rng As Range
Set Rng = Range("A7:AE22")
Dim FindRng As Range
Set FindRng = Rng.Find(What:=FindValue)
Dim FirstCell As String
FirstCell = FindRng.Address
Do
FindRng.Select
Set FindRng = Rng.FindNext(FindRng)
Loop While FirstCell <> FindRng.Address
MsgBox "Search is over"
End Sub
查找范围内字符串的下一次出现
备注
- Range.Find方法有很多参数，你应该好好研究一下。之后你可以修改（'play with'）
findCell函数中的参数。
- 'stars of the show'是
findNextCell函数中的两个static变量。
用法
- 将代码复制到标准模块中，例如
Module1.
- 如果您决定使用按钮 (
Form Control)，则必须为其分配宏 selectNext。
- 如果您决定使用命令按钮 (
ActiveX Control)，则必须将行 selectNext 添加到其单击事件代码中。
代码
Option Explicit
Sub selectNext()
Const CriteriaCellAddress As String = "E2"
Const SearchRangeAddress As String = "A7:AE22"
Dim Criteria As String
Criteria = Range(CriteriaCellAddress).Value
Dim SearchRange As Range
Set SearchRange = Range(SearchRangeAddress)
Dim cel As Range
Set cel = findNextCell(SearchRange, Criteria)
If Not cel Is Nothing Then
cel.Select
End If
End Sub
Function findNextCell(SearchRange As Range, _
ByVal Criteria As String) _
As Range
Static PreviousCellAddress As String
Static CurrentCriteria As String
If CurrentCriteria = "" Or CurrentCriteria <> Criteria Then
CurrentCriteria = Criteria
End If
Dim NextCell As Range
Set NextCell = findCell(SearchRange, CurrentCriteria, PreviousCellAddress)
If Not NextCell Is Nothing Then
' Criteria was found.
PreviousCellAddress = NextCell.Address
Else
' Criteria was not found.
GoTo NoRange ' Exit.
End If
Set findNextCell = NextCell
ProcExit:
Exit Function
NoRange:
Debug.Print "Could not find '" & Criteria & "' in range '" _
& SearchRange.Address(0, 0) & "'."
GoTo ProcExit
End Function
Function findCell(SearchRange As Range, _
ByVal Criteria As String, _
Optional ByVal PreviousCellAddress As String = "") _
As Range
If Criteria = "" Then
GoTo NoCriteria ' Exit.
End If
If SearchRange Is Nothing Then
GoTo NoRange ' Exit.
End If
Dim PreviousCell As Range
If PreviousCellAddress <> "" Then
Set PreviousCell = SearchRange.Worksheet.Range(PreviousCellAddress)
If Intersect(SearchRange, PreviousCell) Is Nothing Then
GoTo OutOfBounds ' Exit.
End If
Else
Set PreviousCell = SearchRange.Cells(SearchRange.Cells.CountLarge)
End If
Set findCell = SearchRange.Find(What:=Criteria, _
After:=PreviousCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
ProcExit:
Exit Function
NoCriteria:
Debug.Print "No criteria ('""')."
GoTo ProcExit
NoRange:
Debug.Print "No range ('Nothing')."
GoTo ProcExit
OutOfBounds:
Debug.Print "The cell '" & PreviousCellAddress _
& "' is not contained in range '" & SearchRange.Address(0, 0) _
& "'."
GoTo ProcExit
End Function
编辑：
在此版本中 selectNext 不同 （第 7 行到最后 non-blank 行） 并且它使用 getColumnsRange 函数：
Sub selectNext()
Const CriteriaCellAddress As String = "E2"
Const FirstRow As Long = 7
Const ColumnsAddress As String = "A:AE"
' Define Criteria.
Dim Criteria As String
Criteria = Range(CriteriaCellAddress).Value
' Define Search Range (from first row to last non-blank row).
Dim SearchRange As Range
Set SearchRange = getColumnsRange(ActiveSheet, ColumnsAddress, FirstRow)
If Not SearchRange Is Nothing Then
' Try to find Next Cell Range.
Dim cel As Range
Set cel = findNextCell(SearchRange, Criteria)
If Not cel Is Nothing Then
cel.Select
End If
End If
End Sub
Function getColumnsRange(Sheet As Worksheet, _
Optional ByVal ColumnsAddress As String = "A", _
Optional ByVal FirstRow As Long = 1) _
As Range
' Define Last Non-Blank Cell Range.
Dim rng As Range
Set rng = Sheet.Columns(ColumnsAddress).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
' Check Last Non-Blank Cell Range.
If rng Is Nothing Then
GoTo BlankColumns
End If
' Check Last Non-Blank Cell Range row against First Row.
If rng.Row < FirstRow Then
GoTo FirstRowBelowLastRow
End If
' Using the row of Last Non-Blank Cell Range, finally define Columns Range.
Set getColumnsRange = Sheet.Range(Sheet.Columns(ColumnsAddress) _
.Rows(FirstRow), _
Sheet.Columns(ColumnsAddress) _
.Rows(rng.Row))
ProcExit:
Exit Function
BlankColumns:
Debug.Print "The columns '" & ColumnsAddress & "' are blank."
GoTo ProcExit
FirstRowBelowLastRow:
Debug.Print "The last non-blank row (" & rng.Row _
& ") is above the first row (" & FirstRow & ")."
GoTo ProcExit
End Function
它只有两个强制参数...它将 return 匹配的单元格范围。
'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'Where search start from First cell and go to last cell.So that we say that search start after lastcell = .cells(.cells.count)
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlPart, Optional SearchOrder As XlSearchOrder = xlByRows, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
'For containing matched range.
Dim SearchResult As Range
'For first matched address.
Dim firstMatch As String
With rng
'Find first Matched result.
Set SearchResult = .Find(What, .Cells(.Cells.Count), LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
'If SearchResult Nothing then set the firstmatched range address to the variable.
If Not SearchResult Is Nothing Then
firstMatch = SearchResult.Address
Do
If FindAll Is Nothing Then
'FindAll = nothing then set FindAll = first match cell
Set FindAll = SearchResult
Else
'If FindAll contain some range then union previous range with new match result range.
Set FindAll = Union(FindAll, SearchResult)
End If
'Change the SearchResult to next matched cell.
'FindNext will start from previous SearchResult address.
Set SearchResult = .FindNext(SearchResult)
'Loop until the SearchResult contains no address or address first address.
Loop While Not SearchResult Is Nothing And SearchResult.Address firstMatch
End If
End With
End Function
大家好，我正在尝试创建一个按钮，它会根据我在单元格 E2 中输入的值，select 全部匹配。它的工作方式有点像 Ctrl + Find 功能，如果我在 E2 中输入 doggo，它将搜索我指定的范围并转到带有 doggo 的第一个单元格，下一次单击按钮时它将转到下一个单元格与狗狗。我在网上研究后得到了这段代码，但它只进入最后一个带有 doggo 的单元格，并且不会从第一个到最后一个循环（例如，如果不同单元格中有三个 doggo，任何人都可以协助突出显示什么是什么与代码？
Sub Button4_Click()
Dim FindValue As String
FindValue = Range("E2")
Dim Rng As Range
Set Rng = Range("A7:AE22")
Dim FindRng As Range
Set FindRng = Rng.Find(What:=FindValue)
Dim FirstCell As String
FirstCell = FindRng.Address
Do
FindRng.Select
Set FindRng = Rng.FindNext(FindRng)
Loop While FirstCell <> FindRng.Address
MsgBox "Search is over"
End Sub
查找范围内字符串的下一次出现
备注
- Range.Find方法有很多参数，你应该好好研究一下。之后你可以修改（'play with'）
findCell函数中的参数。 - 'stars of the show'是
findNextCell函数中的两个static变量。
用法
- 将代码复制到标准模块中，例如
Module1. - 如果您决定使用按钮 (
Form Control)，则必须为其分配宏selectNext。 - 如果您决定使用命令按钮 (
ActiveX Control)，则必须将行selectNext添加到其单击事件代码中。
代码
Option Explicit
Sub selectNext()
Const CriteriaCellAddress As String = "E2"
Const SearchRangeAddress As String = "A7:AE22"
Dim Criteria As String
Criteria = Range(CriteriaCellAddress).Value
Dim SearchRange As Range
Set SearchRange = Range(SearchRangeAddress)
Dim cel As Range
Set cel = findNextCell(SearchRange, Criteria)
If Not cel Is Nothing Then
cel.Select
End If
End Sub
Function findNextCell(SearchRange As Range, _
ByVal Criteria As String) _
As Range
Static PreviousCellAddress As String
Static CurrentCriteria As String
If CurrentCriteria = "" Or CurrentCriteria <> Criteria Then
CurrentCriteria = Criteria
End If
Dim NextCell As Range
Set NextCell = findCell(SearchRange, CurrentCriteria, PreviousCellAddress)
If Not NextCell Is Nothing Then
' Criteria was found.
PreviousCellAddress = NextCell.Address
Else
' Criteria was not found.
GoTo NoRange ' Exit.
End If
Set findNextCell = NextCell
ProcExit:
Exit Function
NoRange:
Debug.Print "Could not find '" & Criteria & "' in range '" _
& SearchRange.Address(0, 0) & "'."
GoTo ProcExit
End Function
Function findCell(SearchRange As Range, _
ByVal Criteria As String, _
Optional ByVal PreviousCellAddress As String = "") _
As Range
If Criteria = "" Then
GoTo NoCriteria ' Exit.
End If
If SearchRange Is Nothing Then
GoTo NoRange ' Exit.
End If
Dim PreviousCell As Range
If PreviousCellAddress <> "" Then
Set PreviousCell = SearchRange.Worksheet.Range(PreviousCellAddress)
If Intersect(SearchRange, PreviousCell) Is Nothing Then
GoTo OutOfBounds ' Exit.
End If
Else
Set PreviousCell = SearchRange.Cells(SearchRange.Cells.CountLarge)
End If
Set findCell = SearchRange.Find(What:=Criteria, _
After:=PreviousCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
ProcExit:
Exit Function
NoCriteria:
Debug.Print "No criteria ('""')."
GoTo ProcExit
NoRange:
Debug.Print "No range ('Nothing')."
GoTo ProcExit
OutOfBounds:
Debug.Print "The cell '" & PreviousCellAddress _
& "' is not contained in range '" & SearchRange.Address(0, 0) _
& "'."
GoTo ProcExit
End Function
编辑：
在此版本中 selectNext 不同 （第 7 行到最后 non-blank 行） 并且它使用 getColumnsRange 函数：
Sub selectNext()
Const CriteriaCellAddress As String = "E2"
Const FirstRow As Long = 7
Const ColumnsAddress As String = "A:AE"
' Define Criteria.
Dim Criteria As String
Criteria = Range(CriteriaCellAddress).Value
' Define Search Range (from first row to last non-blank row).
Dim SearchRange As Range
Set SearchRange = getColumnsRange(ActiveSheet, ColumnsAddress, FirstRow)
If Not SearchRange Is Nothing Then
' Try to find Next Cell Range.
Dim cel As Range
Set cel = findNextCell(SearchRange, Criteria)
If Not cel Is Nothing Then
cel.Select
End If
End If
End Sub
Function getColumnsRange(Sheet As Worksheet, _
Optional ByVal ColumnsAddress As String = "A", _
Optional ByVal FirstRow As Long = 1) _
As Range
' Define Last Non-Blank Cell Range.
Dim rng As Range
Set rng = Sheet.Columns(ColumnsAddress).Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
' Check Last Non-Blank Cell Range.
If rng Is Nothing Then
GoTo BlankColumns
End If
' Check Last Non-Blank Cell Range row against First Row.
If rng.Row < FirstRow Then
GoTo FirstRowBelowLastRow
End If
' Using the row of Last Non-Blank Cell Range, finally define Columns Range.
Set getColumnsRange = Sheet.Range(Sheet.Columns(ColumnsAddress) _
.Rows(FirstRow), _
Sheet.Columns(ColumnsAddress) _
.Rows(rng.Row))
ProcExit:
Exit Function
BlankColumns:
Debug.Print "The columns '" & ColumnsAddress & "' are blank."
GoTo ProcExit
FirstRowBelowLastRow:
Debug.Print "The last non-blank row (" & rng.Row _
& ") is above the first row (" & FirstRow & ")."
GoTo ProcExit
End Function
它只有两个强制参数...它将 return 匹配的单元格范围。
'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'Where search start from First cell and go to last cell.So that we say that search start after lastcell = .cells(.cells.count)
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlPart, Optional SearchOrder As XlSearchOrder = xlByRows, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
'For containing matched range.
Dim SearchResult As Range
'For first matched address.
Dim firstMatch As String
With rng
'Find first Matched result.
Set SearchResult = .Find(What, .Cells(.Cells.Count), LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
'If SearchResult Nothing then set the firstmatched range address to the variable.
If Not SearchResult Is Nothing Then
firstMatch = SearchResult.Address
Do
If FindAll Is Nothing Then
'FindAll = nothing then set FindAll = first match cell
Set FindAll = SearchResult
Else
'If FindAll contain some range then union previous range with new match result range.
Set FindAll = Union(FindAll, SearchResult)
End If
'Change the SearchResult to next matched cell.
'FindNext will start from previous SearchResult address.
Set SearchResult = .FindNext(SearchResult)
'Loop until the SearchResult contains no address or address first address.
Loop While Not SearchResult Is Nothing And SearchResult.Address firstMatch
End If
End With
End Function