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)),"") 

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

---

然后，只需使用评估和公式：

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？你可以用Array公式来做到这一点。

我使用的床单，但只是有两个工作簿打开和使用，修复引用：

的数据是这样的工作表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)),"") 

拖移和向下：