我有一个包含多张纸的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代码。 提前谢谢......
答案 0 :(得分:0)
首先,我将提供一些通用的编码提示:
Variable
。str
开头,双字母dbl
范围r
等。所以strTest
,dblProfit
和rOriginal
。同时为变量提供有意义的名称!好的,这里是两个表之间的比较如何用你的代码作为起点:
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