VBA：使用 Vlookup 和 Offset 提取数据

Question

我正在尝试使用 VBA 从大型电子表格中提取数据。 A 列包含可以根据存储在其中的数据重复的 ID。

例如我有

ID           Value1             Value2
1111         item1               item2
1111         item3               item4
2222         item3               item4
3333         item3               item4
3333         item3               item4

我将 ID 输入到电子表格中，然后想使用 VBA 来查找 ID，然后将 B 列和 C 列中的值拉到另一个电子表格中。

这就是我所拥有的

    Sub populate()
Dim ID As String    
Dim Value1 As String
ID = Range("D5")
   Value1 = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 2, False)
Response = Application.WorksheetFunction.VLookup(ID, Worksheets("Required").Range("A4:J1913"), 7, False)
Worksheets("Coversheet").Range("D8") = Value1
Worksheets("Coversheet").Range("D10") = Value2
Dim Value1address As Long
Value1address = VarPtr(Value1)
Worksheets("Coversheet").Range("D15").Value = Cells(Value1address).Offset(1, 0)
End Sub

除了最后 3 行之外，代码完全按照我的意愿工作。我试图从 Value1 获得 1 行的偏移量，但是它保存为空白，因此将空白值放入单元格 D15。

谁能帮我解决这个问题，或者我如何在 Vlookup 之后轻松地从以下行中获取数据？

Answer 1

我建议使用 Power Query 来完成此任务（如果您已经使用 2016 年，则使用 Get&Transform）： https://www.dropbox.com/s/my59casl9y8ac3y/SO_ExtractDataUsingVLookupAndOffset.xlsx?dl=0

代码很短（例如 Var1）：

let
    Filter= Excel.CurrentWorkbook(){[Name="ID"]}[Content][Column1]{0},
    Source = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
    #"Filtered Rows" = Table.SelectRows(Source, each [ID] = Filter)
in
    #"Filtered Rows"

您拥有输出的所有格式选项，并且解决方案是完全动态的：

Answer 2

使用工作表的MATCH function 将行号返回到INDEX function，同时向其添加+1。

with Worksheets("Required")
    Worksheets("Coversheet").Range("D15").Value = _
      Application.Index(.Range("B4:B1913"), Application.Match(ID, .Range("A4:A1913"), 0) + 1))
End With

如果您正在查找该行，则将其存储并继续重复使用。

    Dim ID As String, val1 As String, val2 As String, val3 As String, rw As Long
    ID = Range("D5")

    With Worksheets("Required")
        If Not IsError(Application.Match(ID, .Range("A4:A1913"), 0)) Then
            rw = Application.Match(ID, .Range("A4:J1913"), 0)
            val1 = .Cells(rw + 3, 2).Value
            val2 = .Cells(rw + 3, 7).Value
            val3 = .Cells(rw + 4, 2).Value
        End If
    End With

    With Worksheets("Coversheet")
        .Range("D8") = val1
        .Range("D10") = val2
        .Range("D15") = val3
    End With

Native Worksheet formulas

这也可以通过标准（非数组）工作表公式来处理。在 D8、D10 和 D15 中，

=INDEX(Required!$B$4:$B$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=INDEX(Required!$J$4:$J$914, MATCH($D$5, Required!$A$4:$A$914, 0))
=IFERROR(INDEX(Required!$B$4:$B$914, AGGREGATE(15, 6, ROW($1:$911)/(Required!$A$4:$A$914=$D$5), 2)), "n/a")