2015-03-24 26 views
1

从源列表中工作表的行(SLW)个列(1,2 & 3)需要粘贴到主列表的工作表(MLW)列(3,4 & 5)[相同的顺序]如果ID号码(SLW1 = MLW3)确实不是已经存在于“主列表”(同一工作簿)中。 我的第一个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 
+0

[Check this out](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros)作为开始。一旦你明确地引用了所有的对象,你就会更接近你想要的东西。还强制变量声明。您可以在* VBE>工具>选项*中启用它,或者您可以简单地在代码最上面添加以下代码:'Option Explicit' – L42 2015-03-24 22:54:05

回答

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其中包含唯一标识符。如果没有,你可以调整上面的代码。

那么这段代码的功能是访问ADO(活动数据对象)能够执行使用SQL命令的数据进行比较。它比传统的Range to Range比较(循环)更快。我不确定它是否比Array to Array比较快,但是一旦你掌握了它,它肯定更容易阅读和调整。无论如何,这可能有点太多了(因为你说这是你的第一个项目),但这是经过尝试和测试,肯定有效。

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

+0

感谢您的帮助。这可能会让我在开始时更加困惑,但希望我能破译它。我尝试运行此宏时出现错误。 “Microsoft数据库引擎找不到对象'SWL $'” – 2015-03-30 22:32:16

+0

@ThomHerold这是假设你的'Sheet'的名字。前面有一个'$'符号。 – L42 2015-03-31 00:51:41

相关问题