Excel 如何使用VBA比较两张图纸并生成新列表？

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

我有两张纸：

• 公开的
• 接触

列A上有一个参数肯定在“联系人”表上，但可能在“公共”表的列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，因为我不需要“不匹配”
• 根据A列按升序排列的结果列表

你能帮我吗

---

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

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

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

`

---

`

正如David所建议的，最好有一个输入和输出示例。也许你可以试试这个：

Option Explicit

Public Sub match()

    Dim wsPub As Worksheet
    Dim wsCon As Worksheet
    Dim wsRes As Worksheet
    Dim pubRow As Long
    Dim conRow As Long
    Dim resRow As Long
    Dim i As Long
    Dim rng As Range
    Dim cel As Range
    Dim found As Long
    Dim order(1 To 5) As Integer

    Set wsPub = ThisWorkbook.Worksheets("public")
    Set wsCon = ThisWorkbook.Worksheets("contacts")
    Set wsRes = ThisWorkbook.Worksheets("result")
    pubRow = wsPub.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
    conRow = wsCon.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
    resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row
    Set rng = wsPub.Range("A2:A" & pubRow)
    order(1) = 1
    order(2) = 3
    order(3) = 7
    order(4) = 6
    order(5) = 7

    For Each cel In rng
        If Not IsError(Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0)) Then
            found = Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0) + 1
            resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row

            For i = 1 To 5
                If i < 4 Then
                    wsRes.Cells(resRow, i).Offset(1, 0).Value _
                    = cel.Offset(0, order(i) - 1).Value
                Else
                    wsRes.Cells(resRow, i).Offset(1, 0).Value _
                    = wsCon.Cells(found, order(i)).Value
                End If
            Next
        End If
    Next

    wsRes.Range("A1").AutoFilter
    wsRes.AutoFilter.Sort.SortFields.Clear
    wsRes.AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("A1:A" & resRow), SortOn:=xlSortOnValues, order:=xlAscending, DataOption:= _
        xlSortNormal
    wsRes.AutoFilter.Sort.Apply

End Sub

选项显式
公共子匹配（）
将wsPub设置为工作表
将wsCon设置为工作表
将wsRes设置为工作表
长得一样暗
暗淡的康罗一样长
长得一样
我想我会坚持多久
变暗rng As范围
暗淡的cel As范围
我发现我和你一样长
以整数形式显示的Dim顺序（1到5）
设置wsPub=thispoolk.Worksheets（“public”）
设置wsCon=ThisWorkbook.Worksheets（“联系人”）
设置wsRes=ThisWorkbook.Worksheets（“结果”）
pubRow=wsPub.Cells（wsPub.Rows.Count，1）.End（xlUp）.Row
conRow=wsCon.Cells（wsPub.Rows.Count，1）.End（xlUp）.Row
resRow=wsRes.Cells（wsRes.Rows.Count，1）.End（xlUp）.Row
设置rng=wsPub.Range（“A2:A”和pubRow）
订单（1）=1
订单（2）=3
订单（3）=7
订单（4）=6
订单（5）=7
对于rng中的每个cel
如果不是IsError（Application.match（cel.Value，wsCon.Range（“A2:A”&conRow），0）），则
found=Application.match（cel.Value，wsCon.Range（“A2:A”&conRow），0）+1
resRow=wsRes.Cells（wsRes.Rows.Count，1）.End（xlUp）.Row
对于i=1到5
如果我小于4，那么
wsRes.Cells（resRow，i）.Offset（1，0）.Value_
=单元偏移量（0，订单（i）-1）.值
其他的
wsRes.Cells（resRow，i）.Offset（1，0）.Value_
=wsCon.Cells（已找到，顺序（i））值
如果结束
下一个
如果结束
下一个
wsRes.范围（“A1”）.自动过滤器
wsRes.AutoFilter.Sort.SortFields.Clear
wsRes.AutoFilter.Sort.SortFields.Add2键=_
范围（“A1:A”&resRow），排序：=xlSortOnValues，顺序：=xlAscending，数据选项：=_
xlSortNormal
wsRes.AutoFilter.Sort.Apply
端接头

根据我的评论，以及您的更新问题和示例，我确信您当前的结果与您所说的不匹配；它同时查找参数“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

这个解决方案利用了数组和字典，它们应该是快速的。它给了我以下结果：

---

您能上传一个输入样本和预期的输出吗？a列中的de参数是否会在联系人上出现两次？@DavidGarcíaBodego编辑为按要求包含。@JvdV是。我忘了解释一个分行可以有多个经理这一事实。请参考我在原稿上的最后一次编辑，因为我已经澄清了这一点。那么你的结果会是什么样子呢。我有点困惑。因为要考虑的第二个参数是管理者。根据您的解释，我将循环查看

联系人

，查看

公共

上是否存在分支机构和经理的组合。如果存在这种情况，您的结果将显示联系人中的A、B、C和D列，这与您上面的整个问题有很大不同。嗨@xyz！我还没能尝试你的解决方案，但我会在白天试一试。谢谢它就像一个符咒！最后一个请求？如果我想在结果cl_cod、产品、motn和年份上列出，如何进行？