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

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

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

现在,我必须比较cList中的E&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)

2 years ago

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

  • set Option Explicit ON . 这可以通过工具>选项>编辑器(选项卡)>需要变量声明来完成 . 现在,您必须在使用它们之前声明所有变量 .

  • 在声明时始终声明变量类型 . 如果您不确定要起诉什么或者是否可以采取不同类型(不建议!!)请使用 Variable .

  • 对所有变量使用标准命名约定 . 我的字符串以 str 开头,而 dbl 的范围是 r 等等 . 所以 strTestdblProfitrOriginal . 同时为您的变量提供有意义的名称!

  • 为您的Excel电子表格提供有意义的名称或 Headers ( Headers 是您在Excel中看到的,name是您可以在VBA中直接引用的名称) . 避免使用 Headers ,而是引用名称,因为用户可以轻松更改 Headers ,但只有在打开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