2015-03-24 31 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

相關問題