连续循环使用Excel中的查找VBA [英] continuous loop using Find in Excel VBA

问题描述

  Sub getAccNos（）
 
 Dim oNameRange As Range 
 Dim oFindRng As Range 
 
 Dim sName As String 
 Dim sAccNo As String 
 
 Set oNameRange = Workbooks（New Name工作表（手册）。范围（B4）
 
尽管不是oNameRange.Text =
 sName = Trim（oNameRange.Text）
工作簿（New Name Work.xls）。工作表（sheet1）。选择
设置oFindRng = Cells.Find（what：= sName，After：= activecell）
 
没有oFindRng不是
 oNameRange.Offset（0，-1）.Value = oFindRng.Offset（0，1）.Text 
 oFindRng.Offset（1，0）.Activate 
设置oFindRng = Cells.Find（什么：= sName，After：= activecell）
循环
设置oNameRange = oNameRange.Offset（1，0）
循环
 End Sub 
  

基本上，在工作表 sheet1 上，我有一个名称列表，帐号，可以有sev具有相同名称的帐号。在我的目标表上，名为手动，我有名字....但是帐号丢失，我想要得到它们。

我不能使用VLOOKUP，因为有几个名称是相同的，我需要得到所有的帐号的列表。我如何做到这一点？

我试图在VBA中使用FIND编写上述代码，不幸的是，我在内部遗漏了一些基本的内容。不断地，当它应该走出去（对于第一个只有一个发生）

感谢向我显示我做错了什么，或者一个公式会是更好？

解决方案

这是一个简单的代码，它不会循环通过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 
 
'~~>这是具有帐号的工作表
设置wsI = ThisWorkbook.Sheets（Sheet1）
'~~>这是我们需要填充帐号的表格
设置wsO = ThisWorkbook.Sheets（Sheet2）
 
带有wsO 
 lRow = .Range（B& ; .Rows.Count）.End（xlUp）.Row 
 
 .Range（A1：A& lRow）.NumberFormat =@
 
对于i = 2 to lRow 
设置aCell = wsI.Columns（2）.Find（What：=。Range（B& i）.Value，_ 
 LookIn：= xlValues，LookAt：= xlPart， _ 
 SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
 
如果不是aCell，则
设置bCell = aCell 
 sAcNo = sAcNo& ，& aCell.Offset（，-1）.Value 
 
 Do 
设置aCell = wsI.Columns（2）.FindNext（After：= aCell）
 
如果不是aCell Is Nothing Then 
如果aCell.Address = bCell.Address然后退出Do 
 sAcNo = sAcNo& ，& aCell.Offset（，-1）.Value 
 Else 
退出Do 
结束如果
循环
结束如果
 
如果sAcNo< > 然后
 .Range（A& i）.Value = Mid（sAcNo，2）
 sAcNo =
 End If 
 Next i 
结束
 End Sub 
  

SCREENSHOT

希望这是你想要的？

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 sheet1 I 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.

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?

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)

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

解决方案

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

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?

这篇关于连续循环使用Excel中的查找VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！