FindNext – 返回多个匹配（稍作修改）

很高兴成为这个论坛的一部分。 好的，我的问题是这样的：

我有2个Excel文件：
一个是具有所有唯一服务器列表的主文件，另一个是具有映射到这些服务器的应用程序的数据库文件。 请注意，在数据库文件中，服务器条目不是唯一的（因为同一台服务器可以托pipe多个应用程序）。

问题是我现在必须“查找”主文件中的每个服务器在“数据库”文件中的位置，并返回相应的应用程序名称。 由于服务器上可能有多个应用程序，我想返回同一行（在相邻列中）的所有应用程序的名称。

例：
如果服务器的名称是主服务器上的ServerA，并且在第二个文件中有3个应用程序（A，B和C）被映射到此，那么在脚本之后，我的主文件应该如下所示：

服务器A：ABC

我的代码似乎只返回到两场比赛。 这并没有超出这个范围，我已经想了很长一段时间了，并且在论坛上search了一遍。 使用的逻辑有错吗？ 请帮忙！

这是我使用的代码：

Dim FindWord As String, Loc As Range Dim aCell As Range Dim database As Worksheet Dim mastersheet As Worksheet Set database = Workbooks("DataBase09052017.xlsm").Worksheets("Sheet1") Set mastersheet = Workbooks("EAS Apps Migration - Master Data Sheet_v2.0.xlsm").Worksheets("EAS Applications") Dim x, y As Integer x = 2 y = 17 Dim a, b, ctr, c As Integer a = 2 b = 23 c = 17 Do Until x = 885 y = 17 FindWord = database.Cells(x, y).Value Set Loc = mastersheet.Range("W2 : W6344").Find(What:=FindWord) If Not Loc Is Nothing Then database.Cells(x, y + 1).Value = mastersheet.Cells(Loc.Row, 1).Value Set aCell = Loc Do Set aCell = mastersheet.Range("W2: W6344").FindNext(aCell) y = y + 1 If Not aCell Is Nothing Then database.Cells(x, y + 1).Value = mastersheet.Cells(aCell.Row, 1).Value End If Loop While aCell <> Loc End If x = x + 1 Loop End Sub 

Answer 1

你能试试吗？ 我认为你的循环比较是closures的（比较Loc和aCell），你可能想要指定一些Find参数而不是“What”。

 Sub x() Dim FindWord As String, Loc As Range Dim aCell As String Dim database As Worksheet Dim mastersheet As Worksheet Set database = Workbooks("DataBase09052017.xlsm").Worksheets("Sheet1") Set mastersheet = Workbooks("EAS Apps Migration - Master Data Sheet_v2.0.xlsm").Worksheets("EAS Applications") Dim x As Long, y As Long x = 2 y = 17 Dim a As Long, b As Long, ctr As Long, c As Long a = 2 b = 23 c = 17 Do Until x = 885 y = 17 FindWord = database.Cells(x, y).Value Set Loc = mastersheet.Range("W2:W6344").Find(What:=FindWord) If Not Loc Is Nothing Then aCell = Loc.Address Do database.Cells(x, y + 1).Value = mastersheet.Cells(Loc.Row, 1).Value Set Loc = mastersheet.Range("W2:W6344").FindNext(Loc) y = y + 1 Loop While aCell <> Loc.Address End If x = x + 1 Loop End Sub