0

I have one excel file with multiple sheets. I need to compare two sheets (1) TotalList and (2) cList with more than 25 columns, in these two sheets columns are same.

On cList the starting row is 3 On TotalList the starting row is 5

Now, I have to compare the E & F columns from cList, with TotalList E & F columns, if it is not found then add the entire row at the end of TotalList sheet and highlight with Yellow.

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

Please help with the VBA code. Thanks in advance...

4

1 回答 1

0

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

  1. 将选项显式设置为 ON。这是通过 Tools > Options > Editor (tab) > Require Variable Declaration 完成的。现在您必须在使用它们之前声明所有变量。
  2. 声明变量类型时总是声明它。如果您不确定要起诉什么，或者它是否可以采取不同的类型（不建议！！），请使用Variable.
  3. 对所有变量使用标准命名约定。我的是一个以 开头的字符串和一个带有 等范围str的双精度数。所以，和。还要给你的变量起有意义的名字！dblrstrTestdblProfitrOriginal
  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
于 2012-11-13T13:33:01.857 回答