Question

我有两个包含数据的excel电子表格。这两个表都包含ID号，然后包含其他相应的数据。表1基本上是包含所有现有ID号（和其他相应数据）的主表，而表2是一组特定数据，仅包含表1中的一些ID号（表2中的所有ID号都存在）在表1中，但不是相反）。目前，工作表1包含A到F列的数据，ID编号在C列，而工作表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     |          
+-------+----------+--------+--------------+-----------+---------+

由于我的工作表包含数十万行，我无法手动执行此操作，因此我需要一个可以更有效地完成此任务的宏。

这是我到目前为止所做的：

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

谢谢

Answer 1

可能采用与您的代码不同的方法，遍历sheet1中的C列并在sheet2中的columnA中找到ID＃，然后获取信息，不需要复制和粘贴。

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

Excel宏根据重复数据合并两个Excel电子表格

1 个答案: