阅读背景:

匹配两个工作表上的三列,并将两个工作表上的行复制到一个新工作表中

来源:互联网 
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
Dim shMix As Worksheet

'Initiate all used objects and variables
Set shOriginal = ThisWorkbook.Sheets("Male")
Set shFind = ThisWorkbook.Sheets("Female")
Set shMix = ThisWorkbook.Sheets("Mix")
Set rTableOriginal = shOriginal.Range(shOriginal.Rows(2), shOriginal.Rows(shOriginal.Rows.count).End(xlUp))
Set rTableFind = shFind.Range(shFind.Rows(2), 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, 1) = rFind.Cells(1, 1) And rOriginal.Cells(1, 13) = rFind.Cells(1, 13) And rOriginal.Cells(1, 11) = rFind.Cells(1, 11) 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 booFound = True Then
                'If not found then copy form the Original sheet ...
                rOriginal.Copy
                rFind.Copy
                '... paste on the Find sheet and apply the Yellow interior color
                With shMix.Rows(Mix.Rows.count + 1)
                    .PasteSpecial

                End With

            End If

FindNextOriginal:
        Next rOriginal
Dim rOriginal As Range          'row records in



你的当前访问异常,请进行认证后继续阅读剩余内容。

分享到: