将源工作表中的唯一数据添加到主工作表

时间:2015-03-24 22:42:09

标签: excel vba excel-vba

源列表工作表( SLW )列(1,2& 3)中的一行需要粘贴到主列表工作表( MLW )列(3, 4& 5)[同一订单]如果唯一的 ID 号码(SLW1 = MLW3) NOT 已经存在于"主列表" (同一工作簿)。 我的第一个Excel VBA项目。所以任何和所有建议/建议/更正/捷径都会很棒。这段代码是我弄乱的创造。如你所知,它不起作用。

Sub Transfer()

    Dim SLR As Integer 'SourceList's Woksheets Last Row
    Dim MLR As Integer 'MasterList's Woksheets Last Row
    Dim SC As Integer 'SourceList Counting through the loop (ROW NUMBER)
    Dim SR As Range 'SourceList A-C Row data
                    '(Source information 3 rows to be transfered)
    Dim ID As Integer 'Unique code of Projects
    Dim Found As Range

    Sheets("SourceList").Activate
    SLR = Cells(Rows.Count, "A").End(xlUp).Row

    'Start loop to go through SourceList unique ID numbers
    For SC = 2 To SLR
        'Copy SourceList ID number into Variable "ID"
        ID = Sheets("SourceList").Range(1, SC)

        'Also, Save Range into Variable so it doesn't have to
        'go back and forth between Worksheets
        Set SR = Range(Cells(1, SC), Cells(3, SC))

        Sheets("MasterList").Activate
        Found = Columns("C:C").Find(What:=ID, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        If Found Is Nothing Then
            MLR = Cells(Rows.Count, "C").End(xlUp).Row + 1
            Range(Cells(3, MLR)) = SR
            SR.ClearContents
        End If
        Sheets("SourceList").Activate
    Next SC
End Sub

1 个答案:

答案 0 :(得分:1)

虽然我已经发布了一个链接供您查看,但我会发布我之前使用过的解决方案。

Sub ject()
    Dim con As Object: Set con = CreateObject("ADODB.Connection")
    Dim rec As Object: Set rec = CreateObject("ADODB.Recordset")

    Dim datasource As String
    datasource = ThisWorkbook.FullName ' returns the fullpath

    Dim sconnect As String
    sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & datasource & ";" & _
                "Extended Properties=""Excel 12.0;HDR=YES"";"
    con.Open sconnect

    Dim sqlstr As String
    ' This basically executes anti-join if you know SQL
    sqlstr = "SELECT * "
    sqlstr = sqlstr & "FROM [SWL$] e "
    sqlstr = sqlstr & "LEFT JOIN [MWL$] u "
    sqlstr = sqlstr & "ON e.ID = u.ID "
    sqlstr = sqlstr & "WHERE u.ID IS NULL "
    sqlstr = sqlstr & "AND e.ID IS NOT NULL;"

    rec.Open sqlstr, con, 3, 1

    ' Dump data that meets your requirement
    With Sheets("MWL")
        Dim lr As Long
        lr = .Range("D" & .Rows.Count).End(xlUp).Row + 1
        .Range("D" & lr).CopyFromRecordset rec
    End With
End Sub

考虑:

  1. 您的SWLMWL工作表数据应从带有标题的第1行开始。 enter image description here
  2. 两者都应包含标题名称 ID ,其中包含唯一标识符。如果没有,您可以调整上面的代码。
  3. 所以代码的作用是访问 ADO(活动数据对象),以便能够使用SQL命令执行数据比较。它比传统的Range to Range比较(循环)更快。我不确定它是否比Array to Array比较快,但是一旦你掌握了它,它肯定更容易阅读和调整。无论如何,这可能有点太多了(因为你说这是你的第一个项目),但这是经过试验和测试的,当然有效。

    重要提示:请注意sconnect变量。您需要使用正确的Connection String,具体取决于您的Excel版本。