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

continuous loop using Find in Excel VBA

提问by Our Man in Bananas

I have the below code, which I am having trouble with:

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

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

Basically, on worksheet sheet1I have a list of names with account number, and there can be several account numbers with the same name. On my target sheet, called Manual, I have the names .... but the account numbers are missing and I would like to get them.

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

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?

我无法使用 VLOOKUP，因为有几个名称相同，我需要获取所有帐号的列表。我怎样才能做到这一点？

I tried to write the above code using FIND in VBA, unfortunately, I am missing something elementary as once in the inside Do Loop it just loops continuously when it should be stepping out (as for the first one there is only one occurrance)

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

thanks for showing me what I am doing wrong, or maybe a formula would be better?

谢谢你告诉我我做错了什么，或者一个公式会更好？

回答by Siddharth Rout

Here is a simple code which doesn't loop through Sheet1 cells to find a match. It uses .FINDand .FINDNEXT. More about it HERE.

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

Place this code in a module and simply run it. This code is based on your sample file.

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

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

SCREENSHOT

截屏

Hope this is what you wanted?

希望这是你想要的吗？

回答by David Zemens

Here is an example. What I would do is count how many occurrences, and then add another variable to increment for each occurrence, and Loop While Not foundCount >= howManyInRange

这是一个例子。我要做的是计算出现的次数，然后添加另一个变量以增加每次出现的次数，然后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

回答by Our Man in Bananas

I really really wanted to create something cool, sexy, snazzy, showy, elegant and clever using a Formula because I could, only it turned out that I couldn't, then it turned out I couldn't even get my Find logic to work, so I did it with a couple of nested loops then checked the results with formulas!

我真的很想用公式来创造一些很酷、性感、时髦、艳丽、优雅和聪明的东西，因为我可以，但结果证明我不能，结果我什至无法让我的 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