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

Question

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

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 中它只是在应该退出时连续循环(对于第一个只有一次出现)

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

Answer 1

这是一个简单的代码，它不会循环遍历 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

屏幕截图

希望这就是您想要的？