Excel VBA 宏 - 查找两列中的单元格与另一个工作簿中的行和列匹配的单元格位置，然后粘贴一个值

Question

因此，在 A 列和 B 列中，工作簿 1 中的两组值应与工作簿 2 中的位置匹配。

    **WORKBOOK 1**
    column A        column B         column C

    a               1                32
    b               2                45
    f               6                12
    g               9                55
    e               5                99

在此图表中，X 标记工作簿 1 中的单元格与工作簿 2 中的位置匹配的位置。列代表 A 列，行代表 B 列。找到该位置后，将粘贴 C 列中的相应值进入该位置。

**WORKBOOK 2**
   1 2 5 9 6
   _ _ _ _ _
a |X
b |  X
f |        X
g |      X   
e |    X   

仅供参考 - 此示例中的行和列来自工作簿 1，而不是默认的列和行号。

我的尝试，但你会用什么来代替“B2”作为位置？

Sub Location()
Dim i as Long, k as Long, ws1 as Worksheet, ws2 as Worksheet
Set ws1 = Workbooks("A").Worksheets("Sheet 1")
Set ws2 = Workbooks("B").Worksheets("Sheet 2")

For i = 1 to 5
variable = ws1.Cells(i, 1) && ws1.Cells(i, 2)
   For k = 1 to 5
   If ws2.Cells(i, 1) && ws2.Cell(1, i) = variable Then
      ws1.Range("C1").Copy 
      ws2.Range("B2").Paste
   End if 
   Next k
Next I

End Sub

期望的输出

   1 2 5 9 6
   _ _ _ _ _
a |32
b |  45
f |        12
g |      55   
e |    99  

关于如何开始这个有什么建议吗？我也知道 vlookup 函数存在，但是使用 VBA 代码可以实现吗？

错误：

这是输入，此图像中的 B 列在示例中充当 C 列。

输入代码：

Sub Location()
    Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
    Dim lastrow As Long

    Set ws1 = Workbooks("Copy of Retrofit Monthly Invoicing 2017.xlsm").Worksheets("Sheet1")
    Set ws2 = Workbooks("Book4").Worksheets("Sheet1")
    lastrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
        For k = 2 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
            ws2.Cells(i, k).Value = ws2.Evaluate("IFERROR(INDEX(" & ws1.Range("B1:B" & lastrow).Address(0, 0, xlA1, 1) & ",AGGREGATE(15,6,ROW(" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & ")" & _
            "/((" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & " = " & ws2.Cells(i, 1).Address(0, 0) & ")*(" & ws1.Range("C1:C" & lastrow).Address(0, 0, xlA1, 1) & "=" & _
            ws2.Cells(1, k).Address(0, 0) & ")),1)),"""")")
        Next k
    Next i

End Sub

Answer 1

如果你不反对配方：

=IFERROR(INDEX(Sheet1!$C:$C,AGGREGATE(15,6,ROW(Sheet1!$A$1:$A$5)/((Sheet1!$A$1:$A$5 = $A2)*(Sheet1!$B$1:$B$5=B$1)),1)),"")

在第一个单元格中，然后复制并上下拖动。

---

然后只需使用 Evaluate 和公式：

Sub Location()
    Dim i As Long, k As Long, ws1 As Worksheet, ws2 As Worksheet
    Dim lastrow As Long

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    lastrow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
        For k = 2 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
            ws2.Cells(i, k).Value = ws2.Evaluate("IFERROR(INDEX(" & ws1.Range("C1:C" & lastrow).Address(0, 0, xlA1, 1) & ",AGGREGATE(15,6,ROW(" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & ")" & _
            "/((" & ws1.Range("A1:A" & lastrow).Address(0, 0, xlA1, 1) & " = " & ws2.Cells(i, 1).Address(0, 0) & ")*(" & ws1.Range("B1:B" & lastrow).Address(0, 0, xlA1, 1) & "=" & _
            ws2.Cells(1, k).Address(0, 0) & ")),1)),"""")")
        Next k
    Next i

End Sub

Answer 2

您需要 VBA 吗？您可以使用数组公式来做到这一点。

我正在使用表格，但只需打开两个工作簿并使用它来修复引用：

Sheet1 上的数据是这样的：

然后，在您的 Sheet2（或其他工作簿等）中，将其放入 A1，然后使用 CTRL+SHIFT+ENTER

输入

=IFERROR(INDEX(Sheet1!$C$1:$C$5,MATCH(ROW()&SUBSTITUTE(ADDRESS(1,COLUMN(),4),"1",""),Sheet1!$B$1:$B$5&Sheet1!$A$1:$A$5,0)),"")

上下拖动：