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

我有一个excel文件和多个工作表。 我需要比较两张表（1）TotalList和（2）cList，其中超过25列，在这两张表中，列是相同的

在cList上，起始行是3 在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

公共函数比较（）
范围很小
范围
迪姆科尔南
我的头发和你的头发一样长
LeaData=“Shhet2”
ConsolData=“Sheet1”
TotRows=工作表（LeaData）.范围（“D65536”）.结束（xlUp）.行
TotRows1=工作表（控制台数据）。范围（“D65536”）。结束（xlUp）。行
'TotRows=ThisWorkbook.Sheets（LeaData）.UsedRange.Rows.Count
ColNam=“$F$3:$F”&TotRows
ColNam1=“$F$5:$F”&总计1
对于每个活页范围（LeaData）。范围（ColNam）
Set FoundRang=Sheets（ConsolData）.Range（ColNam1）.Find（LoopRang，lookat:=xlother）
表格中的每个FoundRange（控制台数据）。范围（ColNam1）
如果FoundRang和FoundRang.Offset（0，-1）LoopRang和LoopRang.Offset（0，-1），则
TotRows=工作表（控制台数据）。范围（“D65536”）。结束（xlUp）。行
ThisWorkbook.Worksheets（LeadData）.行（LoopRange.Row）.复制ThisWorkbook.Worksheets（ConsoleData）.行（TotRows+1）
ThisWorkbook.Worksheets（ConsoleData）.Rows（TotRows+1）.Interior.Color=vbYellow
转到下一行
如果结束
下一站
下一行：
下一圈
端函数

请帮助了解VBA代码。

---

提前感谢…

首先，我将给出一些一般的编码提示：

将选项显式设置为ON。这是通过工具>选项> 编辑器（选项卡）>需要变量声明。现在你必须 在使用之前声明所有变量

声明变量类型时，请始终声明它。如果您不确定要起诉什么，或者它是否可以采取不同的类型（不可取！！），请使用

Variable

对所有变量使用标准命名约定。我的是一个以

str

开头的字符串和一个以

dbl

开头的双精度字符串，范围是

r

，等等。。所以

strTest

，

dblProfit

和

rooriginal

。还要给变量起一个有意义的名字

为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

---

一条路径：@OP:请告诉我们你到目前为止已经做了什么。这不是一个免费的脚本服务，这是为那些有编程问题的程序员提供的，因为他们被卡住了，或者想改进脚本，诸如此类的事情。因此，请将您的脚本发布给我们，告诉我们您遇到了什么问题，我们将尽力提供帮助。更新了上面的代码，在上面的代码中，它正在复制工作表中已有的数据。