创建一个 VBA 宏来提取匹配数据

Question

我正在寻找有关如何在 Excel 中构建 VBA 宏（我以前从未创建过宏）的指导，该宏将在两个单独的 [=34= 中寻找唯一标识符匹配] 文件，然后将提取匹配的伴随行数据。

说白了：

我有两个单独的 excel 文件，每个文件都有一列作为唯一标识符。
我希望 VBA 宏在其中一个文件中找到唯一标识符与另一个文件中的唯一标识符相同的匹配项。
在 Excel 文件中找到匹配项后，我想提取找到匹配项的特定行的数据。
理想情况下，我希望将提取的数据放入新的 excel 工作表中。

Answer 1

这个例子将引导您做您想做的事。以下是您必须采取或考虑的步骤：

启用开发者工具
在 VBA
在模块顶部添加一些常量
创建代码来检查工作簿是否打开；
--如果没有，打开
-- 如果工作簿不存在，则创建并打开
创建将使用上述代码打开一本或多本书的代码
创建将循环遍历文件 1 中的行的代码，签入文件 2 并在找到匹配项的位置写入文件 3

在Excel

中启用开发者工具

使用本文：https://msdn.microsoft.com/en-us/library/bb608625.aspx

打开第一个文件。然后创建一个模块，如下一个主题所示

创建模块

使用这篇文章并按照它进行到第 3 步 - 创建模块：https://www.ablebits.com/office-addins-blog/2013/12/06/add-run-vba-macro-excel/

创建常量

编写下面的代码来声明文件名和 sheet 名称的常量。

Const FIRST_FILE_NAME As String = "Book1.xlsx" ' This current file
Const SECOND_FILE_NAME As String = "Book2.xlsx"
Const RESULTANT_FILE_NAME As String = "Result.xlsx"

Const wstFirst As String = "Sheet1" ' Sheet name of first file
Const wstSecond As String = "Sheet1"
Const wstResultant As String = "Sheet1"

创建将检查工作簿是否打开的代码

将这段代码写在常量声明代码下面

' Check if a workbook is open; if inexistant, create one
Function Isworkbookopen(FileName As String)

    Dim ff As Long, ErrNo As Long
    Dim wkb As Workbook
    Dim nam As String

    wbname = FileName

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff

    ErrNo = Err

    On Error GoTo 0
    Select Case ErrNo
        Case 0: Isworkbookopen = False
        Case 70: Isworkbookopen = True
        Case 53:
            Workbooks.Add
            ActiveWorkbook.SaveAs FileName:=RESULTANT_FILE_NAME
            Isworkbookopen = False
        Case Else: Error ErrNo
    End Select

End Function

如果文件不存在，创建一个新文件并报告文件未打开。我刚刚在 VBA macro to copy data from one excel file to another 答案中使用了 Dan Wagner 的代码。其余代码也是对 Dan 代码的修改。

创建打开一本书的代码

接下来将此代码写在其余代码的下方。此代码将采用文件名和引用变量。如果工作簿未打开，请打开它并将其分配给引用变量。您必须自己阅读 ByRef。

' Open a workbook and pass the reference back
Private Sub OpenBook(FileName As String, ByRef wkb As Workbook)
    ret = Isworkbookopen(FileName)
    If ret = False Then
        Set wkb = Workbooks.Open(FileName)
    Else
        Set wkb = Workbooks(FileName)
    End If
End Sub

创建将执行循环并在结果文件中插入数据的代码

将此代码写在您当前代码的底部。此代码将打开所有 3 本书（第一本书、第二本书和将粘贴数据的结果书）。逐行读取第一个文件（假设第一个和第二个文件之间的公共字段仅读取第一个单元格）。然后，文件1

Sub copydata()

    Dim wkbFirst As Workbook
    Dim wkbSecond As Workbook
    Dim wkbResultant As Workbook

    ' open all 3 files
    OpenBook FIRST_FILE_NAME, wkbFirst
    OpenBook SECOND_FILE_NAME, wkbSecond
    OpenBook RESULTANT_FILE_NAME, wkbResultant

    Dim First_File_Counter As Integer, Second_File_Counter As Integer, Resultant_File_Counter As Integer
    Dim First_Value As String, Second_Value As String
    Resultant_File_Counter = 1

    ' loop from row 1 to a large number for file #1
    For First_File_Counter = 1 To 10000

        ' get value of A1, then A2 and so on during each loop
        ' if that cell does not have a value, assume that there're no more rows of data
        First_Value = wkbFirst.Worksheets(wstFirst).Range("A" & First_File_Counter).Value
        If IsNull(First_Value) Or Len(Trim(First_Value)) = 0 Then Exit For

        ' loop from row 1 to a large number for file #2
        ' and look up information obtained from file #1 in file #2
        For Second_File_Counter = 1 To 10000
            Second_Value = wkbSecond.Worksheets(wstSecond).Range("A" & Second_File_Counter).Value
            If IsNull(Second_Value) Or Len(Trim(Second_Value)) = 0 Then Exit For

            ' if first file's A1 matches any of the rows in this second file
            ' copy the row from first file into the resultant file
            If First_Value = Second_Value Then
                wkbFirst.Worksheets(wstFirst).Rows(First_File_Counter).EntireRow.Copy
                wkbResultant.Worksheets(wstResultant).Rows(Resultant_File_Counter).Select
                wkbResultant.Worksheets(wstResultant).Paste
                Resultant_File_Counter = Resultant_File_Counter + 1
                Exit For
            End If
        Next
    Next

End Sub

例子

我创造了Book1.xlsx。我有：

    A    B
  ----- --------
1  UID  Name
2   1   John
3   2   Matt
4   3   Katie

Book2.xlsx 有

    A    B
  ----- --------
1  UID  Address
2   1   100 2nd St, Chicago
3   3   Lukas Tower, Houston

当我点击任何一行copycode并按下F5时，copycode子程序将运行。它将遍历代码，然后生成的文件将如下所示：

    A    B
  ----- --------
1  UID  Name
2   1   John
3   3   Katie

请注意，文件 1 中的数据转到了文件 3，但只有那些在文件 2 中具有匹配 UID 的行才这样做。 Matt 在文件 1 中的行没有转到结果文件，因为文件 2 没有 UID 2。

希望这会让你明白。

创建一个 VBA 宏来提取匹配数据

Creating a VBA Macro to Extract Data for matches

excel

data-extraction