如何比较不同工作表中的两列

时间:2012-11-12 11:28:56

标签: excel vba excel-vba

我有一个包含多张纸的excel文件。 我需要比较两个表(1)TotalList和(2)cList超过25列,在这两个表中列是相同的。

在cList上,起始行为3 在TotalList上,起始行为5

现在,我必须比较E&来自cList的F列,具有TotalList E& 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代码。 提前谢谢......

1 个答案:

答案 0 :(得分:0)

首先,我将提供一些通用的编码提示:

  1. 设置Option Explicit ON。这是通过工具&gt;完成的。选项&gt; 编辑(标签)&gt;需要变量声明。现在你必须 在使用之前声明所有变量。
  2. 在声明变量时始终声明变量类型。如果您不确定要起诉的内容或是否可以采取不同的类型(不建议!!)请使用Variable
  3. 对所有变量使用标准命名约定。我的字符串以str开头,双字母dbl范围r等。所以strTestdblProfitrOriginal 。同时为变量提供有意义的名称!
  4. 为您的Excel电子表格提供有意义的名称或标题(标题是您在Excel中看到的,name是您可以在VBA中直接引用的名称)。避免使用标题,但请改为使用标题,因为用户可以轻松更改标题,但只有在打开VBA窗口时才能更改名称。

  5. 好的,这里是两个表之间的比较如何用你的代码作为起点:

    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