在 Excel VBA 中使用查找的连续循环

Posted 2023-03-11

【中文标题】在 Excel VBA 中使用查找的连续循环

【英文标题】：continuous loop using Find in Excel VBA

【发布时间】：2013-04-24 13:06:50

【问题描述】：

我有以下代码，但我遇到了问题：

Sub getAccNos()

Dim oNameRange As Range
Dim oFindRng As Range

Dim sName As String
Dim sAccNo As String

Set oNameRange = Workbooks("New Name Work.xls").Worksheets("Manual").Range("B4")

Do While Not oNameRange.Text = ""
    sName = Trim(oNameRange.Text)
    Workbooks("New Name Work.xls").Worksheets("sheet1").Select
    Set oFindRng = Cells.Find(What:=sName, After:=activecell)

    Do While Not oFindRng Is Nothing
        oNameRange.Offset(0, -1).Value = oFindRng.Offset(0, 1).Text
        oFindRng.Offset(1, 0).Activate
        Set oFindRng = Cells.Find(What:=sName, After:=activecell)
    Loop
    Set oNameRange = oNameRange.Offset(1, 0)
Loop
End Sub

基本上，在工作表 sheet1 我有一个带有帐号的名称列表，并且可以有多个具有相同名称的帐号。在我的名为Manual的目标表上，我有名字....但是帐号不见了，我想得到它们。

我无法使用 VLOOKUP，因为有几个名称相同，我需要获取所有帐号的列表。我该怎么做？

我尝试在 VBA 中使用 FIND 编写上述代码，不幸的是，我错过了一些基本的东西，因为在内部 Do Loop 中它只是在应该退出时连续循环（至于第一个只有一次出现)

感谢您向我展示我做错了什么，或者也许一个公式会更好？

【问题讨论】：

之所以没有变成什么，是因为工作表中的所有单元格每次都包含在搜索区域中。所以它到达底部后只会跳回顶部。

【参考方案1】：

受 David Zemens 的启发，我稍微增强了代码并对其进行了测试，结果是肯定的。此代码不需要激活单元格，因为有时我们需要隐藏工作表。 请相应地更改一些代码。

Function EAN40_Explosion(EAN40 As String) As Variant
   Dim ws As Object: Set ws = Sheet13 ' Material master
   Dim Delimiter As String, cString As String, result() As String
   Dim howManyInRange As Long
   Dim foundCount As Long
   Dim oFindRange As Range
   Dim rngSearch As Range
   Dim srchVal As String
   Dim AfterCell As Range   
   Delimiter = " "
   srchVal = EAN40
   Set rngSearch = ws.Range("g:g")  'EAN40
   Set AfterCell = rngSearch.Cells(1, 1)
   '## First, check to see if the value exists.'
        Do
            Set oFindRange = rngSearch.Find(what:=srchVal, after:=AfterCell, SearchDirection:=xlNext)
            '## Avoid duplicate and infinite loop:'
            If oFindRange Is Nothing then
               Exit Do
            else
               if  oFindRange.Row <= AfterCell.Row Then
                   exit do
               endif                   
            End If               
            Set AfterCell = oFindRange
            '## Do your stuff, here.'
            If cString = Empty Then
                cString = ws.Cells(oFindRange.Row, 1).text
            Else
                cString = cString & Delimiter & ws.Cells(oFindRange.Row, 1).text
            End If
            Debug.Print oFindRange.Address
        Loop 
        result() = Split(cString, Delimiter)
        EAN40_Explosion = result()

End Function

【参考方案2】：

这是一个简单的代码，它不会遍历 Sheet1 单元格来查找匹配项。它使用.FIND 和.FINDNEXT。更多相关信息HERE。

将此代码放在一个模块中并简单地运行它。此代码基于您的示例文件。

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim lRow As Long, i As Long
    Dim sAcNo As String
    Dim aCell As Range, bCell As Range

    '~~> This is the sheet which has account numbers
    Set wsI = ThisWorkbook.Sheets("Sheet1")
    '~~> This is the sheet where we need to populate the account numbers
    Set wsO = ThisWorkbook.Sheets("Sheet2")

    With wsO
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        .Range("A1:A" & lRow).NumberFormat = "@"

        For i = 2 To lRow
            Set aCell = wsI.Columns(2).Find(What:=.Range("B" & i).Value, _
                        LookIn:=xlValues, LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

            If Not aCell Is Nothing Then
                Set bCell = aCell
                sAcNo = sAcNo & "," & aCell.Offset(, -1).Value

                Do
                    Set aCell = wsI.Columns(2).FindNext(After:=aCell)

                    If Not aCell Is Nothing Then
                        If aCell.Address = bCell.Address Then Exit Do
                        sAcNo = sAcNo & "," & aCell.Offset(, -1).Value
                    Else
                        Exit Do
                    End If
                Loop
            End If

            If sAcNo <> "" Then
                .Range("A" & i).Value = Mid(sAcNo, 2)
                sAcNo = ""
            End If
        Next i
    End With
End Sub

屏幕截图

希望这是你想要的？

【讨论】：

+1 非常感谢，在我写的那篇文章中，每条记录只有一个帐号，但我更喜欢您的解决方案，其中所有帐号都没有。显示每个名字！

是的，我的代码基于您的评论I cannot use VLOOKUP because there are several names that are the same and I need to get a list of all the account numbers. How can I do this?

【参考方案3】：

我真的很想用公式创造一些酷、性感、时髦、艳丽、优雅和聪明的东西因为我可以，但结果证明我做不到，然后我发现我什至无法让我的 Find 逻辑工作，所以我用几个嵌套循环做了它，然后用公式检查了结果！

Sub getAccNos()

Dim oNameRange As Range
Dim oFindRng As Range

Dim sName As String
Dim sAccNo As String

Application.ScreenUpdating = False
Set oNameRange = Workbooks("New Name Work.xls").Worksheets("Manual").Range("B4")

Do While Not oNameRange.Text = ""
    sName = Trim(oNameRange.Text)
    Workbooks("New Name Work.xls").Worksheets("sheet1").Select
    Range("C2").Select
    Do Until activecell.Text = ""
        If Trim(activecell.Text) = sName Then
            Do
                oNameRange.Offset(0, -1).Value = activecell.Offset(0, 1).Text
                Set oNameRange = oNameRange.Offset(1, 0)
                activecell.Offset(1, 0).Select
            Loop While activecell.Text = sName
            GoTo NextName
        Else
            activecell.Offset(1, 0).Select
        End If
    Loop
NextName:
Application.StatusBar = "Row " & oNameRange.Row & " (" & oNameRange.Text & ")"
Loop
Application.ScreenUpdating = True
End Sub

【讨论】：

Philip，如果您的介绍是对 OP 的讽刺，请您改变一下吗？如果不是，请原谅我的误解

@K_B Philip 是 OP :)

您还在寻找解决方案吗？如果是，那么我可以发布一个不使用循环但使用 .Find 和 .FindNext

的解决方案

好的 :) 你有我可以使用的示例文件吗？您还想要从 VBA 或用户定义函数运行的代码（可以从工作表调用）

@SiddharthRout 对不起，不能提供文件，因为它很好，人们的信息，从 VBA 运行它就可以了。

【参考方案4】：

这是一个例子。我要做的是计算出现的次数，然后为每次出现添加另一个变量以递增，Loop While Not foundCount >= howManyInRange

Sub FindInRange()

Dim howManyInRange As Long
Dim foundCount As Long
Dim oFindRange As Range
Dim rngSearch As Range
Dim srchVal As String

srchVal = "Steve"
Set rngSearch = Range("D:D")

'## First, check to see if the value exists.'

howManyInRange = Application.WorksheetFunction.CountIf(rngSearch, srchVal)

If Not howManyInRange = 0 Then
    Do
        Set oFindRange = rngSearch.Find(what:=srchVal, After:=ActiveCell)
        '## Avoid duplicate and infinite loop:'
        foundCount = foundCount + 1
        oFindRange.Activate
        '## Do your stuff, here.'

        Debug.Print oFindRange.Address

    Loop While Not foundCount >= howManyInRange
End If

End Sub

【讨论】：

我喜欢这个，你能拥有它，这样我们就不需要活动单元格了吗？