按顺序查找事件 - VBA

时间:2017-01-06 13:23:18

标签: excel vba excel-vba search

我使用的是从本网站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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

将中间的循环更改为:

'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)