跨另一个工作簿工作表的 Excel VBA 查找

Question

我正在使用以下代码在另一个工作簿中查找数据并收集数据。我已经能够get it to work 在书 2.xlsm 中为我位于 test.xlsx 中的 data entry sheet

Sub copydata() 
Dim rw As Long, x As Range 
Dim extwbk As Workbook, twb As Workbook

Set twb = ThisWorkbook
Set extwbk = Workbooks.Open("/Users/username/desktop/test.xlsx")
Set x = extwbk.Worksheets("Data entry").Range("A1:GZ400")

With twb.Sheets("Sheet1")

    For rw = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(rw, 2) = Application.VLookup(.Cells(rw, 1).Value2, x, 11, False)
    Next rw

End With

With twb.Sheets("sheet1")

         For rw = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(rw, 3) = Application.VLookup(.Cells(rw, 1).Value2, x, 12, False)
    Next rw

End With

    extwbk.Close savechanges:=False
End Sub

我还想做的是让 VBA 提取（我猜是使用间接和 vlookup 的组合？） test.xlsx 中的integral data from the additional sheets 并放入 book2 整数值。 test.xlsx 中的这些工作表名称将根据示例名称而改变，但这些名称将与 book2 的 sheet1 中的名称相同，对于整数名称也是如此。

有人可以帮助指导我如何添加到此代码并解决此问题吗？我是 VBA 新手，所以我还在学习。我的实际文档要大得多，所以最后我需要调整参考单元格，所以请尝试解释其中一些内容的含义，以便我知道我将要做什么。

Answer 1

注意：最后的工作代码。

我想说最简单的方法是为您要填充的范围编写一个工作公式。然后，您可以开始录制您键入公式的宏。通过一些编辑，您可以在子例程中正确插入生成的代码。

第 1 步：编写公式。

由于在您的子例程中 test.xlsx 将打开，因此您可以在打开 test.xlsx 时编写和测试您的公式。您已经正确地猜到了您需要的公式（VLOOKUP 和 INDIRECT）。但为了便于解释，我们假设您从一个更简单的公式开始，例如单元格 D4 的公式：

=VLOOKUP(D$3,'[test.xlsx]sample 1'!$D:$H,5,FALSE)

要使其动态选择正确的工作表，我们需要编辑table_array 部分。在其中，有两个部分是不变的：'[test.xlsx] 和 '!$D:$H。它们可以写成字符串。 sample 1 包含在该行的第一个单元格中，所以我们只写一个对它的引用。因此，我们的公式将如下所示：

=VLOOKUP(D$3,INDIRECT("'[test.xlsx]" & $A4 & "'!$D:$H"),5,FALSE)

我们的公式相当实用。让我们录制宏。

第 2 步：录制和编辑宏。

开始录制，选中有公式的单元格，按F2，回车，停止录制。然后您可以转到 VBA，在那里您会找到（可能在一个新模块中）您刚刚录制的宏。它很可能看起来像这样：

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("D4").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(R3C,INDIRECT(""'[test.xlsx]"" & RC1 & ""'!$D:$H""),5,FALSE)"
    Range("D5").Select
End Sub

在所有这些代码中，我们真正关心的是.FormulaR1C1 = "=VLOOKUP(R3C,INDIRECT(""'[test.xlsx]"" & RC1 & ""'!$D:$H""),5,FALSE)"。如您所见，它更改了给定范围的属性 FormulaR1C1。基本上我们可以插入一个字符串（如果格式正确），它将被读取为具有 RC（行列）类型引用的公式。有关它的更多信息here。在集成这个公式的同时，我们还可以根据我们的代码更改'[test.xlsx] 部分以使用引用。所以我们改变这个：

.FormulaR1C1 = "=VLOOKUP(R3C,INDIRECT(""'[test.xlsx]"" & RC1 & ""'!$D:$H""),5,FALSE)""

进入这个：

.FormulaR1C1 = "=VLOOKUP(R3C,INDIRECT(""'[" & extwbk.Name & "]"" & RC1 & ""'!$D:$H""),5,FALSE)"

这样，万一 extwbk 有不同的名称，生成的公式仍然有效。我们也可以基本上对公式中的所有变量做同样的事情。

现在我们需要确定公式的目标范围。我们的代码中已经有一个可以使用的范围变量。请注意，变量的单个字母名称不是最好的。您应该选择一个至少包含 3 个字母的名称，您可能在其余代码中找不到该名称。这将使搜索和最终给定变量的编辑变得更容易。给变量添加一个“标签”以强调它是什么类型的变量也是一个好习惯（例如Rng，如果它是一个范围，比如RngMyCell）。在代码中为不同的目的使用相同的模糊调用变量也是有风险的，但由于它是一个非常短的代码，我们应该没问题（你仍然可以在以后相应地改进代码）。无论如何，要确定范围，我们可以使用 Resize 和 Offset 从单元格 D3 开始，如下所示：

With twb.Sheets("Sheet1")
    Set x = .Range(.Range("D3"), .Cells(3, .Columns.Count).End(xlToLeft))
    Set x = x.Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 3, x.Columns.Count).Offset(1, 0)
End With

然后我们可以将我们的公式应用于x 范围。由于我们对公式的结果感兴趣，而不是对公式本身感兴趣，我们可以添加一个x.Values = x.Values 行来用它们的结果代替公式。因此，我们的代码将是这样的：

With twb.Sheets("Sheet1")
    Set x = .Range(.Range("D3"), .Cells(3, .Columns.Count).End(xlToLeft))
    Set x = x.Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 3, x.Columns.Count).Offset(1, 0)
    x.FormulaR1C1 = "=VLOOKUP(R3C,INDIRECT(""'[" & extwbk.Name & "]"" & RC1 & ""'!$D:$H""),5,FALSE)"
    x.Value = x.Value
End With

我们的代码已准备好集成到我们的子程序中。

第 3 步：集成代码

我们可以将我们的代码放在我们的子程序中。但首先我们也可以合并两个With twb.Sheets("Sheet1")，因为它们是相同的，并将我们的代码放在同一个 with 语句中。我们还可以注意到，在我们的 For-Next 循环中缺少一个点。的最终结果应该是这样的：

Sub copydata()
    
    Dim rw As Long, x As Range
    Dim extwbk As Workbook, twb As Workbook
    
    Set twb = ThisWorkbook
    Set extwbk = Workbooks.Open("/Users/username/desktop/test.xlsx")
    Set x = extwbk.Worksheets("Data entry").Range("A1:GZ400")
    
    With twb.Sheets("Sheet1") '<-- this with is the same as the next one. No need to repeat it.
    
        For rw = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row '<-- the ".Rows.Count" didn't have the point.
            .Cells(rw, 2) = Application.VLookup(.Cells(rw, 1).Value2, x, 11, False)
        Next rw
        
        For rw = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row '<-- the ".Rows.Count" didn't have the point.
            .Cells(rw, 3) = Application.VLookup(.Cells(rw, 1).Value2, x, 12, False)
        Next rw
        
        Set x = .Range(.Range("D3"), .Cells(3, .Columns.Count).End(xlToLeft))
        Set x = x.Resize(.Cells(.Rows.Count, 1).End(xlUp).Row - 3, x.Columns.Count).Offset(1, 0)
        x.FormulaR1C1 = "=VLOOKUP(R3C,INDIRECT(""'[" & extwbk.Name & "]"" & RC1 & ""'!$D:$H""),5,FALSE)"
        x.Value = x.Value
        
    End With

    extwbk.Close savechanges:=False
End Sub