按顺序查找事件——VBA [英] Finding occurrences in order -- VBA

查看:56
本文介绍了按顺序查找事件——VBA的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我使用的是从本网站获得的代码,使用 VBA 查找所有实例.一切正常,但由于某种原因,它从第二个出现循环到文件末尾,然后获得第一个.

I am using the code that I obtained from this website, Find All Instances With VBA. Everything works fine, but for some reason it starts with the second occurrence loops to the end of file, then obtains the first.

例如:

-- 示例数据:

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"的 Origin 列中查找所有出现时,然后我通过 Debug.Print (rng.Address) 检索地址,它将提供 $A$4,7 澳元、9 澳元、11 澳元、2 澳元.

When I try to find all occurrence in column Origin of letter "S", then I retrieve the address through Debug.Print (rng.Address) it would provide $A$4,$A$7,$A$9,$A$11,$A$2.

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

Why is $A$2 being shown last? This has happened throughout all my different excel files.

代码如下:

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

推荐答案

你的循环实际上找到了 A2 作为第一个单元格,但它又找到了它,因为你在 Find() 返回到第一个找到的单元格.

your loop actually finds A2 as the first cell but then it finds it again because you're looping one more time after Find() wraps back to the first found cell.

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

thus Set rng = Union(rng, FoundCell) adds A2 once again to rng as the last found cell, and that's why you see it listed at the bottom

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

You must move the checking as the ending condition of your loop and not to have Set rng = Union(rng, FoundCell) run after wrapping back

如下:

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

这篇关于按顺序查找事件——VBA的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆