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

你需要VBA吗？您可以使用数组公式来执行此操作。

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

Sheet1 上的数据是这样的：

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

输入

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

上下拖动：

Answer 2

如果你不反对公式：

=IFERROR(INDEX(Sheet1!$C:$C,AGGREGATE(15,6,ROW(Sheet1!$A:$A)/((Sheet1!$A:$A = $A2)*(Sheet1!$B:$B=B)),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

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

Excel VBA macro - find the cell location from which cells in two columns match the row and column in another workbook then paste a value

excel

vba

location

matching

conditional-statements