按顺序查找事件——VBA

Question

我正在使用从该网站获得的代码Find All Instances With VBA。一切正常，但由于某种原因，它从第二次出现循环到文件末尾，然后获得第一次。

例如：

-- 样本数据：

Origin  X   Y
S   45  65
W   78  7
S   45  5
D   6   3
B   75  68
S   19  87
T   23  98
S   33  94
Q   21  105
S   17  117
T   12  128

当我尝试在字母“S”的来源列中查找所有出现时，我通过Debug.Print (rng.Address) 检索地址，它将提供$A$4,$A$7,$A$9,$A$11,$A$2。

为什么最后显示 $A$2？这发生在我所有不同的 excel 文件中。

代码如下：

Sub FindAll()

'PURPOSE: Find all cells containing a specified values
'SOURCE: www.TheSpreadsheetGuru.com

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

'What value do you want to find (must be in string form)?
  fnd = "S"

Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)

'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If

Set rng = FoundCell

'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)

    'Add found cell to rng range variable
      Set rng = Union(rng, FoundCell)

    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do

  Loop

'Select Cells Containing Find Value
  rng.Select

  Debug.Print (rng.Address)

Exit Sub

'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"

End Sub

Answer 1

您的循环实际上找到了 A2 作为第一个单元格，但随后又找到了它，因为您在 Find() 回绕到第一个找到的单元格后又循环了一次。

因此 Set rng = Union(rng, FoundCell) 再次将 A2 添加到 rng 作为最后找到的单元格，这就是为什么您会看到它列在底部

您必须将检查作为循环的结束条件，并且在回绕后不要让 Set rng = Union(rng, FoundCell) 运行

如下：

Option Explicit

Sub FindAll()
    'PURPOSE: Find all cells containing a specified values
    'SOURCE: www.TheSpreadsheetGuru.com

    Dim fnd As String, FirstFound As String
    Dim FoundCell As Range, rng As Range

    'What value do you want to find (must be in string form)?
    fnd = "S"

    With ActiveSheet.UsedRange '<--| reference the range to search into
        Set FoundCell = .Find(what:=fnd, after:=.Cells(.Cells.Count)) '<--| find the first cell

        If Not FoundCell Is Nothing Then 'Test to see if anything was found
            FirstFound = FoundCell.Address ' <--| store the first found cell address
            Set rng = FoundCell '<--| initialize the range collecting found cells. this to prevent first 'Union()' statement from failing due to 'rng' being 'Nothing'
            Do
                Set rng = Union(rng, FoundCell)  'Add found cell to rng range variable

                'Find next cell with fnd value
                Set FoundCell = .FindNext(after:=FoundCell)
            Loop While FoundCell.Address <> FirstFound 'Loop until cycled through all finds

            rng.Select 'Select Cells Containing Find Value
            Debug.Print (rng.Address)
        Else
            MsgBox "No values were found in this worksheet"
        End If
    End With
End Sub

Answer 2

将中间的循环更改为：

'What value do you want to find (must be in string form)?
fnd = "S"

Set myRange = ActiveSheet.UsedRange

With myRange
    Set FoundCell = .Find(fnd, LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
        firstAddress = FoundCell.Address

        Do
            'Add found cell to rng range variable
            If rng Is Nothing Then
                Set rng = FoundCell '<-- add first range found
            Else
                Set rng = Union(rng, FoundCell) '<-- add ranges by using Union
            End If

            Set FoundCell = .FindNext(FoundCell)
            If FoundCell Is Nothing Then
                GoTo DoneFinding
            End If
            Loop While Not FoundCell Is Nothing And FoundCell.Address <> firstAddress
    End If
DoneFinding:
End With

Debug.Print (rng.Address)