find匹配项后select下一个条件

我有一个城市列表作为search条件，我期待拉取相应城市的邮编。

列A包含所有城市，列B是邮编列表，列D是用户将input要search城市名称的标准列。 search后，相应的邮政编码将列E列。我有以下在VBA只抓住从D1的search条件，但我想知道是否有一种方法来searchD2的标准后，初步search，并下降一行一行，直到D列有空行。

Sub Test2() Dim Find As String Dim finalrow As Integer Dim i As Integer Find = Sheets("Test").Range("D1").Value finalrow = Sheets("Test").Range("A10000").End(xlUp).Row For i = 2 To finalrow If Cells(i, 1) = Find Then Range(Cells(i, 2), Cells(i, 3)).Copy Range("E10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats End If Next i End Sub 

Answer 1

我明白，你正在寻求一个基于VBA的解决scheme，但一个标准的公式可以完成同样的事情。

E2中的标准公式是，

=IFERROR(INDEX(B$2:B$999, SMALL(INDEX(ROW($1:$998)+(A$2:A$999<>D$2)*1E+99, , ), ROW(1:1))), "")

填充足够数量的行来捕捉所有可能的匹配。 在D2中键入城市将立即返回全套匹配的拉链。 当它用完匹配，它会简单地返回一个空string（因此需要填充足够的行以容纳最大的一组匹配）。 我曾经看过COUNTA用来比较A列中匹配的数量和E列中匹配的数量，并且如果公式未被充分填充以捕捉所有可能，则显示红色。

FWIW，如果我正在计划一个基于VBA的解决scheme，我会使用WorksheetFunction.Match而不是遍历每一行，

Answer 2

尝试这个：

 Dim wsh as Worksheet Dim i As Integer Set wsh = ThisWorkbook.Worksheets("Sheet1") i = 0 Do While wsh.Range("D1").Offset(ColumnOffset:=i)<>"" 'your code i=i+1 Loop 

始终在上下文中使用代码。 为什么？ 简单范围（“A1”）是指ActiveSheet 。 检查这个：

 Sub CodeContext Sheets(1).Activate Range("A1") = 1 Sheets(2).Activate Range("A1") = 2 End Sub 

Answer 3

尝试下面。 您可以使用IsEmpty确定列表的末尾，假设最后一个列表项目之后的单元格实际上是空的，并且列A中没有列表中间为空的空单元格。

 Sub Test2() Dim rRngFind As Range Dim rRngCity As Range Dim rRngResult As Range Dim i As Integer 'Set Input cell for Find, I chose D2 Set rRngFind = Sheets("Test").Range("D2") 'Set first city search row, presumably not the top row since you will have headings and such Set rRngCity = Sheets("Test").Range("A2") 'Set Cell for first result, I chose E2 Set rTngResult = Sheets("Test").Range("E2") Do Until IsEmpty(rRngCity) If rRngFind.Value = rRngCity.Value Then rTngResult.Value = Sheets("Test").Range("B" & rRngCity.Row).Value i = rTngResult.Row + 1 Set rTngResult = Sheets("Test").Range("E" & i) End If 'increment the row i = rRngCity.Row + 1 Set rRngCity = Sheets("Test").Range("A" & i) Loop End Sub