2012-11-12 49 views
0

我有一個包含多個工作表的excel文件。 我需要比較兩個工作表(1)TotalList和(2)cList超過25列,在這兩個工作表欄中是相同的。如何比較不同工作表中的兩列

在分欄列表的起始行是3 在TotalList的起始行是5

現在,我得比較來自CLIST對E &˚F列,TotalListē&˚F列,如果沒有找到它,然後在TotalList表格末尾添加整行,並用黃色突出顯示。

Public Function compare() 
    Dim LoopRang As Range 
    Dim FoundRang As Range 
    Dim ColNam 
    Dim TotRows As Long 

    LeaData = "Shhet2" 
    ConsolData = "Sheet1" 

    TotRows = Worksheets(LeaData).Range("D65536").End(xlUp).Row 
    TotRows1 = Worksheets(ConsolData).Range("D65536").End(xlUp).Row 
    'TotRows = ThisWorkbook.Sheets(LeaData).UsedRange.Rows.Count 
    ColNam = "$F$3:$F" & TotRows 
    ColNam1 = "$F$5:$F" & TotRows1 
    For Each LoopRang In Sheets(LeaData).Range(ColNam) 
     Set FoundRang = Sheets(ConsolData).Range(ColNam1).Find(LoopRang, lookat:=xlWhole) 
     For Each FoundRang In Sheets(ConsolData).Range(ColNam1) 
      If FoundRang & FoundRang.Offset(0, -1) <> LoopRang & LoopRang.Offset(0, -1) Then  
       TotRows = Worksheets(ConsolData).Range("D65536").End(xlUp).Row 
       ThisWorkbook.Worksheets(LeaData).Rows(LoopRang.Row).Copy ThisWorkbook.Worksheets(ConsolData).Rows(TotRows + 1) 
       ThisWorkbook.Worksheets(ConsolData).Rows(TotRows + 1).Interior.Color = vbYellow 
       GoTo NextLine 
      End If 
     Next FoundRang 
NextLine: 
    Next LoopRang 

End Function 

請幫助VBA代碼。 在此先感謝...

+0

一個路徑:http://superuser.com/a/496277/ 85273 – Brad

+0

@OP:請告訴我們你到目前爲止所做的事情。這不是免費的腳本服務,這是針對有編程問題的程序員,因爲他們被卡住或想要改進腳本,這類事情。因此,請向我們發送您的腳本,並告訴我們您卡在哪裏,我們將盡我們所能幫助。 –

+0

更新了上面的代碼,在上面的代碼中,它正在複製已經在工作表中的數據。 – user1049518

回答

0

首先,我打算給一些通用的編碼提示:

  1. 集顯式的選項打開。這是通過工具>選項> 編輯器(選項卡)>需要變量聲明完成的。現在,您必須在使用它們之前聲明所有變量爲 。
  2. 在聲明它時總是聲明一個變量類型。如果您不確定要起訴什麼或者是否可以採用不同的類型(不可取!!),請使用Variable
  3. 對所有變量使用標準命名約定。礦井是一個以str開頭的字符串,dblr等的一個範圍。所以strTest,dblProfitrOriginal。同時給你的變量意味着名字!
  4. 爲您的Excel電子表格提供有意義的名稱或標題(標題是您在Excel中看到的內容,名稱是您可以在VBA中直接引用的名稱)。請避免使用標題,而應參考名稱,因爲用戶只需打開VBA窗口即可輕鬆更改標題,但只能使用該名稱。

好了,所以這裏是如何的兩個表之間的比較可以與您的代碼來完成爲出發點:

Option Explicit 

Public Function Compare() 

     Dim rOriginal As Range   'row records in the lookup sheet (cList = Sheet2) 
     Dim rFind As Range    'row record in the target sheet (TotalList = Sheet1) 
     Dim rTableOriginal As Range  'row records in the lookup sheet (cList = Sheet2) 
     Dim rTableFind As Range   'row record in the target sheet (TotalList = Sheet1) 
     Dim shOriginal As Worksheet 
     Dim shFind As Worksheet 
     Dim booFound As Boolean 

     'Initiate all used objects and variables 
     Set shOriginal = ThisWorkbook.Sheets("Sheet2") 
     Set shFind = ThisWorkbook.Sheets("Sheet1") 
     Set rTableOriginal = shOriginal.Range(shOriginal.Rows(3), shOriginal.Rows(shOriginal.Rows.Count).End(xlUp)) 
     Set rTableFind = shFind.Range(shFind.Rows(5), shFind.Rows(shFind.Rows.Count).End(xlUp)) 
     booFound = False 

     For Each rOriginal In rTableOriginal.Rows 
      booFound = False 
      For Each rFind In rTableFind.Rows 
       'Check if the E and F column contain the same information 
       If rOriginal.Cells(1, 5) = rFind.Cells(1, 5) And rOriginal.Cells(1, 6) = rFind.Cells(1, 6) Then 
        'The record is found so we can search for the next one 
        booFound = True 
        GoTo FindNextOriginal 'Alternatively use Exit For 
       End If 
      Next rFind 

      'In case the code is extended I always use a boolean and an If statement to make sure we cannot 
      'by accident end up in this copy-paste-apply_yellow part!! 
      If Not booFound Then 
       'If not found then copy form the Original sheet ... 
       rOriginal.Copy 
       '... paste on the Find sheet and apply the Yellow interior color 
       With rTableFind.Rows(rTableFind.Rows.Count + 1) 
        .PasteSpecial 
        .Interior.Color = vbYellow 
       End With 
       'Extend the range so we add another record at the bottom again 
       Set rTableFind = shFind.Range(rTableFind, rTableFind.Rows(rTableFind.Rows.Count + 1)) 
      End If 

FindNextOriginal: 
     Next rOriginal 

End Function 
相關問題