vba 用于比较两个工作表并突出显示发生更改的位置的宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20523908/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Macro to compare two worksheets and highlight where a change has occured
提问by HayleyW
I would like to create a macro within a workbook that can be used as a comparison tool.
我想在工作簿中创建一个可用作比较工具的宏。
Historical data will be added to Worksheet 1 'Historical'. Then current data will be added to Worksheet 2 'New'. The data is in exactly the same format.
历史数据将添加到工作表 1“历史”中。然后当前数据将被添加到工作表 2 的“新建”中。数据的格式完全相同。
The macro should look down column G in worksheet 1 (which is a key identifier) and also column O (which shows a status). Then this data should be compared to column G and O in worksheet 2.
宏应该查看工作表 1 中的 G 列（这是一个关键标识符）和 O 列（显示状态）。然后应将此数据与工作表 2 中的 G 列和 O 列进行比较。
If column G is a match but column O has changed then the entire row, from Worksheet 2 'New', should be pasted into Worksheet 3 'Results'.
如果 G 列匹配但 O 列已更改，则应将工作表 2“新建”中的整行粘贴到工作表 3“结果”中。
Example;
例子;
Worksheet 1 'Historical' - Column G, 123456789 and Column O, Not Valid
工作表 1“历史”- G 列，123456789 和 O 列，无效
Worksheet 2 'New' - Column G, 123456789 and Column O, Valid
工作表 2“新”- G 列，123456789 和 O 列，有效
As there is a match in column G but the status has changed, the row from Worksheet 2 will be pasted into the next free row in Worksheet 3 'Results'
由于 G 列中有匹配项但状态已更改，因此工作表 2 中的行将粘贴到工作表 3“结果”中的下一个空闲行中
Any help would be greatly appreciated. I have played around with adding Vlookup and Countif into the macro without much success.
任何帮助将不胜感激。我已经尝试将 Vlookup 和 Countif 添加到宏中，但没有取得多大成功。
回答by DaveU
This may give you an idea, hope it's helpful.
这可能会给你一个想法，希望它有帮助。
Sub matchMe()
Dim wS As Worksheet, wT As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range
Set wS = ThisWorkbook.Worksheets("Sheet1")
Set wT = ThisWorkbook.Worksheets("Sheet2")
With wS
Set r1 = .Range("G1", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
End With
With wT
Set r2 = .Range("G1", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
End With
On Error Resume Next
For Each cel1 In r1
With Application
Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in sheet2
If Err = 0 Then
If cel1.Offset(, 8) <> cel2.Offset(, 8) Then copyRow cel2 'if difference, copy
End If
Err.Clear
End With
Next cel1
End Sub
Sub copyRow(cel As Range)
Dim w As Worksheet, r As Range
Set w = ThisWorkbook.Worksheets("Sheet3")
Set r = w.Cells(w.Rows.Count, Columns("G:G").Column).End(xlUp).Offset(1) 'next row
cel.EntireRow.Copy w.Cells(r.Row, 1)
End Sub
