找到匹配项后选择下一个条件

Question

我有一个城市列表作为搜索条件，我希望拉出相应城市的邮政编码。

列A包含所有城市，列B是邮政编码列表，列D是标准列，用户将在其中输入要搜索的城市的名称。在搜索之后，相应的邮政编码将列在E列上。我在VBA中有以下内容，它只从D1中获取搜索条件，但我想知道是否有办法在初始搜索后搜索D2上的条件并向下搜索逐行，直到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的解决方案，但标准公式可以完成同样的事情。

E2中的标准公式是

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

填写足够数量的行以捕获所有可能的匹配。将城市键入D2将立即返回完整的匹配拉链。当它用完匹配时，它只会返回一个空字符串（因此需要填充足够的行以容纳最大的匹配集）。我看到COUNTA用于比较A列中的匹配数与E列中的匹配数，如果公式未充分填充以显示红色，则显示红色。

FWIW，如果我计划基于VBA的解决方案，我会使用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