excel - 如何比较两张工作表并使用 VBA 生成新列表？

问题描述

事先请注意，我刚开始使用 VBA，在此之前我几乎没有编码经验。

我有两张纸：

上市
联系人

A 列上有一个参数肯定在“联系人”表上，但可能在或不在“公共”表的 A 列上。

我正在做的是：

检查参数contacts.A2是否在public.A2上。

如果是，我需要按照确切的顺序复制列：

公众：A、C、G。联系人：E、F。

我在网上找到了以下代码，并且正在对其进行一些修改，但我被卡住了。

Sub match()

Dim I, total, frow As Integer
Dim found As Range

total = Sheets("public").Range("A" & Rows.Count).End(xlUp).Row
'MsgBox (total) '(verifica se a contagem está ok)

For I = 2 To total
   pesquisa = Worksheets("public").Range("A" & I).Value
Set found = Sheets("contacts").Columns("A:A").Find(what:=pesquisa) 'finds a match

If found Is Nothing Then
    Worksheets("result").Range("W" & I).Value = "NO MATCH"
Else
    frow = Sheets("contacts").Columns("A:A").Find(what:=pesquisa).Row
    Worksheets("result").Range("A" & I).Value = Worksheets("public").Range("A" & frow).Value
    Worksheets("result").Range("B" & I).Value = Worksheets("public").Range("C" & frow).Value
    Worksheets("result").Range("C" & I).Value = Worksheets("public").Range("G" & frow).Value
    Worksheets("result").Range("D" & I).Value = Worksheets("contacts").Range("F" & frow).Value
    Worksheets("result").Range("E" & I).Value = Worksheets("contacts").Range("G" & frow).Value
End If
Next I
End Sub

我的期望：

代码忽略第 1 行，因为它们是标题；
消除上面的 de IF，因为我不需要“NO MATCH”
到要根据 A 列按升序排序的结果列表。

你能帮助我吗？

编辑以包括数据样本和预期结果：

我相信我可以用上面的图片简化我的需求。我想在公共表上检查一个客户，从联系人表中获取经理联系人（电子邮件），并在结果表上创建一个包含分支、经理和两封电子邮件的列表。

创建这些图像时，我意识到我忘记考虑第二个参数（经理），因为一个分支上可能有多个经理。所以这是另一个需要考虑的参数。

标签： excelvbalistloopspaste

根据我的评论以及您对示例的更新问题，我确实认为您当前的结果与您所说的不符；它正在寻找参数“Branch”和“Manager”。您的预期结果也不像您想要根据您的问题提取的列。但是，根据您的示例数据和预期输出，我尝试了以下操作：

Sub BuildList()

'Define your variables
Dim x As Long, y As Long
Dim arr1 As Variant, arr2 As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

'Fill 1st array variable from sheet Contacts
With Sheet1 'Change accordingly
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr1 = .Range("A2:D" & x).Value
End With

'Fill dictionary with first array
For x = LBound(arr1) To UBound(arr1)
    dict.Add arr1(x, 1) & "|" & arr1(x, 2), arr1(x, 3) & "|" & arr1(x, 4)
Next x

'Fill 2nd array variable from sheet Public
With Sheet2 'Change accordingly
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr2 = .Range("A2:B" & x).Value
End With

'Compare array against dictionary and fill sheet Results
With Sheet3 'Change accordingly
    y = 2
    For x = LBound(arr2) To UBound(arr2)
        If dict.Exists(arr2(x, 1) & "|" & arr2(x, 2)) Then
            .Cells(y, 1).Value = arr2(x, 1)
            .Cells(y, 2).Value = arr2(x, 2)
            .Cells(y, 3).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(0)
            .Cells(y, 4).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(1)
            y = y + 1
        End If
    Next x
End With

End Sub

该解决方案使用了应该很快的数组和字典。它给了我以下结果：

excel - 如何比较两张工作表并使用 VBA 生成新列表？

问题描述

解决方案

推荐阅读