Excelmacros将基于重复数据的两个Excel电子表格组合在一起
我有两个包含数据的Excel电子表格。 这两张表都包含一个ID号码，然后是其他相应的数据。 工作表1本质上是一个包含所有现有ID号（和其他相应数据）的主表，而表2是一组特定的数据，它们将只包含表1中的一些ID号（表2中的所有ID号在表1中，但不是相反的方式）。 当前，工作表1包含A到F列的数据，C列中有ID编号，而工作表2包含列A到C的数据，列A上有ID编号。还要注意，当我们移动时，ID编号是递增的在表单中，每个ID号码都是唯一的。
我想要的是，如果来自工作表2的ID等于工作表1中的ID，那么我想从工作表2中的B和C列到工作表1中相应行的末尾，然后删除工作表1中的任何行中工作表2中不存在相同的ID号。为了说明，工作表1如下所示：
+-------+----------+--------+--------------+ |Year |Country | ID #: |Columns D,E,F | +-------+----------+--------+--------------+ |2012 |CA |123456 |data | +-------+----------+--------+--------------+ |2015 |US |565382 |data | +-------+----------+--------+--------------+ |2008 |US |765382 |data | +-------+----------+--------+--------------+ |2012 |CA |956471 |data | +-------+----------+--------+--------------+ 工作表2如下所示：
+-------+----------+--------+ |ID #: |Quantity |Value | +-------+----------+--------+ |123456 |435 |12523 | +-------+----------+--------+ |765382 |1136 |52342 | +-------+----------+--------+ |956471 |49 |5562 | +-------+----------+--------+
然后在合并具有相同ID号的行并从表1中删除不包含来自表2的对应ID的所有行之后，我们得到：
+-------+----------+--------+--------------+-----------+---------+ |Year |Country | ID #: |Columns D,E,F |Quantity |Value | +-------+----------+--------+--------------+-----------+---------+ |2012 |CA |123456 |data |435 |12523 | +-------+----------+--------+--------------+-----------+---------+ |2008 |US |765382 |data |1136 |52342 | +-------+----------+--------+--------------+-----------+---------+ |2012 |CA |956471 |data |49 |5562 | +-------+----------+--------+--------------+-----------+---------+
由于我的工作表包含数十万行，因此我无法手动执行此操作，所以我需要一个可以更有效地完成此任务的macros。
这是我到目前为止：
Sub mergeSheets() Dim c As Range, cfind As Range, x, dest As Range, cfind1 As Range On Error Resume Next Worksheets("sheet3").Cells.Clear With Worksheets("Sheet1") .UsedRange.Copy Worksheets("sheet3").Range("a1") For Each c In Range(.Range("a2"), .Range("c2").End(xlDown)) x = c.Value With Worksheets("sheet2") Set cfind = .Cells.Find(what:=x, lookat:=xlWhole) If cfind Is Nothing Then GoTo line1 .Range(cfind.Offset(0, 1), cfind.End(xlToRight)).Copy With Worksheets("sheet3") Set cfind1 = .Cells.Find(what:=x, lookat:=xlWhole) If cfind1 Is Nothing Then GoTo line1 cfind1.End(xlToRight).Offset(0, 1).PasteSpecial End With 'sheet3 End With 'sheet2 line1: Next End With 'Sheet 1 Application.CutCopyMode = False End Sub
谢谢
也许与你的代码不同的方法，通过sheet1中的C列循环，并在sheet2中的columnA中findID＃，然后获取信息，复制和粘贴将不是必需的。
Sub Get_It() Dim sh As Worksheet, ws As Worksheet Dim LstRw As Long, Rng As Range, c As Range, Fx As Range Set sh = Sheets("Sheet1") Set ws = Sheets("Sheet2") With sh LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row Set Rng = .Range("C2:C" & LstRw) For Each c In Rng.Cells Set Fx = ws.Columns(1).Find(what:=c, lookat:=xlWhole) If Not Fx Is Nothing Then c.Offset(, 4) = Fx.Offset(, 1) c.Offset(, 5) = Fx.Offset(, 2) Else: MsgBox c & " is Not Found"' remove msgbox if desired, just an example End If Next c End With End Sub