Question

我是一名动画师，编程对我来说仍然很新，但之前我的老板通过将两个不同的xls文件合并为一个来为我分配了一份工作。我设法在这里研究一些代码并使用VBA代码复制并根据新的工作簿标题粘贴数据。

例如，这是文件

  Username  Name  Date  Image   Attempt  Date  Image   Status
    222      AA    Aug    No       1 
    182      BB    Mar   Yes       0
    100      CC    Aug    No       1
    787      DD    Mar   Yes       0

但是现在我遇到了从另一个xls文件移动下面的数据的麻烦。并根据“用户名”“名称”标题合并它们。因为它包含新的数据列。

    Username  Name  Date   Image    Status  
    222        AA   2013    Color     good 
    182        BB   2011    B/W       bad
    100        CC   2011    B/W       bad
    669        EE   2013    Color     good

我需要把它们变成下面的东西

  Username  Name  Date  Image   Attempt  Date  Image   Status
    222      AA    Aug    No       1     2013   Color   good
    182      BB    Mar   Yes       0     2011   B/W     bad
    100      CC    Aug    No       1     2011   B/W     bad 
    787      DD    Mar   Yes       0     2013   Color   good 
    669      EE                          2013   Color   good

如果有任何关键字或指南对我有很大帮助。

Answer 1

这应该带来所有数据，并将任何尚未存在于wb1中的数据添加到文件末尾，并在日期，图像和尝试下添加空白区域。

Dim wb1, wb2 as Workbooks
Dim ws1, ws2 as Worksheets
Dim c3ll1, c3ll2, range1, range2 as Range

Set wb1 = Workbooks("Name1")
Set wb2 = Workbooks("Name2")
Set ws1 = wb1.Worksheets("name")
Set ws2 = wb2.Worksheets("name")

lastrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

Set range2 = ws2.Range("A2:A" & lastrow2)

For each c3ll2 in range2
    a = 0
    lastrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    Set range1 = ws1.Range("A2:A" & lastrow1)
    activerow2 = c3ll2.Row

    For each c3ll1 in range1
        If c3ll1.Value = c3ll2.Value then
            activerow1 = c3ll1.Row
            ws1.Cells(activerow1, 6) = ws2.Cells(activerow2, 3)
            ws1.Cells(activerow1, 7) = ws2.Cells(activerow2, 4)
            ws1.Cells(activerow1, 8) = ws2.Cells(activerow2, 5)
            a = 1                                                   'Username is found
        End if
    Next c3ll1

    If a = 0 then                       'If Username is not found print at end
        ws1.Cells(lastrow1 + 1, 1) = ws2.Cells(activerow2, 1)
        ws1.Cells(lastrow1 + 1, 2) = ws2.Cells(activerow2, 2)
        ws1.Cells(lastrow1 + 1, 6) = ws2.Cells(activerow2, 3)
        ws1.Cells(lastrow1 + 1, 7) = ws2.Cells(activerow2, 4)
        ws1.Cells(lastrow1 + 1, 8) = ws2.Cells(activerow2, 5)
    End If
Next c3ll2

根据值为新列分配数据并合并重复数据

1 个答案: