合并两个Excel表(使用VBA)

合并两个Excel表(使用VBA),vba,excel,Vba,Excel,我一直在想如何使用VBA将同一工作簿中的两个表合并到第三个表中。例如: 工作表1: From To Value Italy Japan 1000 France Japan 500 Canada Japan 0 France Italy 700 工作表2: From To Value Italy Japan 5555 France Japan 1111 Canada Japan 777 Canada France

我一直在想如何使用VBA将同一工作簿中的两个表合并到第三个表中。例如:

工作表1:

From     To     Value
Italy    Japan  1000
France   Japan  500
Canada   Japan  0
France   Italy  700
工作表2:

From     To     Value
Italy    Japan  5555
France   Japan  1111
Canada   Japan  777
Canada   France 333
不需要的输出(工作表3):

我需要一个VBA解决方案,因为原始表大约有400行长,我需要对几个工作簿执行相同的操作。我将非常感谢任何关于这个问题的建议

编辑: 如果有人对它感兴趣,我设法制作了一个工作代码。工作表1是“列表导入”的昵称,工作表2是“列表导出”。在这两张纸中,我都插入了一列(C),列明了这两个国家。我使用新列和值在工作表3(现在是“Combolist”)中构建表


虽然这可以用VBA解决,但使用公式可能会更好(除非您必须经常这样做)。VBA解决方案将需要一些专门知识,如果您希望能够维护该解决方案,甚至需要更多

Excel公式将非常简单。首先,创建一个
UniqueID
列:

UniqueID        From     To     Value
Italy_Japan     Italy    Japan  1000  
France_Japan    France   Japan  500   
Canada_Japan    Canada   Japan  0     
France_Italy    France   Italy  700
Canada_France   Canada   France     
对这两张桌子做同样的事情。接下来,获取所有唯一的
UniqueID
。为此,您可以使用
数据
删除重复项
,只需确保在删除重复项之前进行复制,否则您将从源中删除记录。将此唯一ID列表放入新的
表中
。请记住,如果您的所有数据都是
表格
格式,则所有这些都会变得更容易(在表格范围内时,您将在功能区中看到
表格
选项卡)

如果需要将数据格式化为表格,请转到工作表,按CTRL+HOME键(这将转到第一个单元格)。如果您的第一个单元格位于另一个位置,则只需导航到该位置。如果您的表格是工作表上的唯一数据,请尝试从此处使用
CTRL+SHIFT+END
突出显示到最后使用的单元格。否则,组合使用
CTRL+SHIFT+RIGHT
CTRL+SHIFT+DOWN
将获得您所需的内容。最后,命名为y我们的表格出于对所有excel的热爱,这个简单的习惯可以节省大量时间。在我的示例中,我假设您有一个
表格

组合表中的公式如下所示:

=IfError(Vlookup([UniqueID],Primary,Column(Primary[Value]),False),“”)

或者,如果
Primary
表没有从第一列开始,请使用以下命令:

=IfError(Vlookup([UniqueID],Primary,4,False),“”)

这里的不同之处在于,前者将随着列的移动而更改索引,后者则不会,并且如果编辑了表,则必须对其进行编辑

在下一列中对另一个表执行相同的操作:

=IfError(Vlookup([UniqueID],Secondary,Column(Primary[Value]),False),“”)

=IfError(Vlookup([UniqueID],Secondary,4,False),”)

这将基于共享的
UniqueID
将两个集合“合并”,如果记录不存在,则会留下空白。学习如何这样做可能不如学习如何在VBA中这样做方便,但如果您不能使用这样的实现,我强烈劝劝劝您不要尝试学习VBA


需要明确的是,公式方法之所以在这种情况下是理想的,是因为您请求帮助的任务非常简单,您可以更好地发展您的Excel技能,因为这样做可以让您在将来更快地解决类似的任务。即使是新手也可以实现此解决方案在15分钟左右的时间内,您可以轻松地用几天的时间学习可扩展的VBA解决方案。

您已经尝试的代码在哪里,您遇到的错误在哪里?感谢BraX的关注。我还没有绑定任何内容。我已经制作了一个高效的VBA代码,用于从丑陋的表中构建工作表1和工作表2中的列表s、 但是现在我被卡住了…如果你有想法,就告诉我,我会试着用它来编写代码!你在雇佣程序员吗?你付了多少钱让我们为你编写所有的代码而不用自己付出任何努力?要清楚@Annick他们的意思是什么,所以不是一个“请为我编写此代码”的网站。当你征求意见时对于那些已经编写了代码但很难理解为什么它不起作用的程序员来说,从哪里开始通常也是如此。也就是说,我提供了一个非VBA的答案,应该能让您找到正确的方向。如果您需要VBA解决方案,您需要先进行研究并学习基础知识。感谢Brandon Barney的帮助您的见解。我的位置确实不在这里,因为我不是程序员,但我见过许多其他堆栈溢出用户向新手提问,并获得建议。我必须时不时地为Excel或Word编写简单的VBA代码,所以我不是本能地这样做。在这种情况下,我非常确定我需要一个包含4列的结果表,所以我非常满意我是多么害怕做双vlookup或类似的事情。我没有想到像你建议的那样创建一个UniqueID。当你向我指出这一点时,它变得容易多了,现在我的代码已经完成并运行良好。@Annick我很高兴它成功了,我完全同意这是一个初学者的地方。但同时,这也带来了一些问题小心。给你你需要的工具是很容易的,这很危险。给你作为一个程序员成功所需要的工具是很困难的(至少在回答的范围内)我强烈推荐在VBA之前尽可能多地发展你的公式技巧,如果不是因为没有这样做的话,所有的事情都会成为VBA的问题。我仍然在挖那个洞,我通常认为自己在VBA上是体面的。所以现在我更可能先看合理的公式解决方案,然后再看。
Sub combolist()
    Dim lastRowImp As Long, lastRowExp As Long, startPaste As Long, endPaste As Long
    Dim ws As Worksheet, Lookup_Range As Range, i As Integer
    Dim lastRow As Long

    lastRowImp = Sheets("List Import").Cells(Rows.Count, 1).End(xlUp).Row
    lastRowExp = Sheets("List Export").Cells(Rows.Count, 1).End(xlUp).Row
    startPaste = lastRowImp + 1
    endPaste = lastRowImp + lastRowExp - 1

    'add a new sheet and headers
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Combolist"
    Sheets("Combolist").Range("B1") = "Import"
    Sheets("Combolist").Range("C1") = "Export"
    Sheets("Combolist").Range("C1").EntireRow.Font.Bold = True

    'copy flows from import and export list
    Sheets("Combolist").Range("A1:A" & lastRowImp) = Sheets("List Import").Range("C1:C" & lastRowImp).Value
    Sheets("Combolist").Range("A" & startPaste & ":A" & endPaste) = Sheets("List Export").Range("C2:C" & lastRowExp).Value

    'remove duplicates
    lastRow = Sheets("Combolist").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Combolist").Range(Cells(1, 1), Cells(lastRow, 1)).RemoveDuplicates Columns:=Array(1), Header:=xlYes

    Set ws = ActiveWorkbook.Sheets("Combolist")
    lastRow = Sheets("Combolist").Cells(Rows.Count, 1).End(xlUp).Row

    'populate Import values
    Set Lookup_Range = Sheets("List Import").Range("C1:D" & lastRowImp)

    With ws
        For i = 2 To lastRow
            On Error Resume Next
                If Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False) = "" Then
                ws.Cells(i, 2) = 0
                Else
                ws.Cells(i, 2) = Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False)
                End If
        Next i
    End With

    'populate Export values
    Set Lookup_Range = Sheets("List Export").Range("C1:D" & lastRowExp)

    With ws
        For i = 2 To lastRow
            On Error Resume Next
                If Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False) = "" Then
                ws.Cells(i, 3) = 0
                Else
                ws.Cells(i, 3) = Application.WorksheetFunction.VLookup(ws.Cells(i, 1), Lookup_Range, 2, False)
                End If
        Next i
    End With

End Sub
UniqueID        From     To     Value
Italy_Japan     Italy    Japan  1000  
France_Japan    France   Japan  500   
Canada_Japan    Canada   Japan  0     
France_Italy    France   Italy  700
Canada_France   Canada   France