在Excel VBA中使用Find进行连续循环

我有下面的代码，我遇到了麻烦：

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我有一个名称与帐户号码列表，可以有多个同名的帐号。 在我的目标表上，名为手册 ，我有名字….但帐号丢失，我想得到它们。

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

我尝试在VBA中使用FIND来编写上面的代码，不幸的是，我在内部丢失了一些基本的内容，例如Do循环，当它应该被逐出时，它会连续循环（至于第一个只有一个发生）

感谢给我看我做错了什么，或者一个公式会更好？

Answer 1

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

把这个代码放在一个模块中，然后运行它。 此代码基于您的示例文件。

 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 

屏幕截图

希望这是你想要的？

Answer 2

这是一个例子。 我要做的是统计出现了多less次，然后添加另一个variables来增加每次出现的次数，而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 

Answer 3

我真的很想用一个公式来创造一些很酷，性感，时髦，华丽，优雅和聪明的东西， 因为我可以 ，只是事实certificate，我不能 ，那么事实certificate，我甚至无法让我的查找逻辑工作，所以我做了几个嵌套循环，然后用公式检查结果！

 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