按顺序查找事件 – VBA

我正在使用从本网站获得的代码， 查找所有使用VBA的实例 。 一切工作正常，但由于某种原因，它开始第二次出现循环到文件的结尾，然后获得第一个。

例如：

– 样本数据：

Origin XY 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 

当我试图find所有出现在字母“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它，因为在Find()返回到第一个find的单元格之后再循环一次。

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

您必须移动检查作为您的循环的结束条件，而不是在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)