2012-11-12 50 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 
相关问题