dynamicmnacro比较两个表，并添加行，如果没有在一个表上find或更新信息，如果find行，但一些信息不同

我被困在写这个Excelmacros，可以好心的使用一些帮助。 我正在尝试创build一个dynamicmacros，它将比较两个不同工作表中的两个表，如果不同，则会更新行的信息，如果不存在，则将新行复制到新表中。 两个表都包含相同的信息列，并且每个数据行都有唯一的产品代码。 一旦按下button，如果在新表上找不到表1中行的产品代码，那么该行将被复制。 如果在新表中find产品代码，但列中的其他信息不同，则将在新表上更新其他信息。 如果find产品代码并且其他信息相同，则不会复制该行。 我需要在table1中尽可能多的行。

注意：我认为VLOOKUP可能是成功编写这个macros的路线…下面是我迄今为止的尝试得到这个工作。

Sub Copy_Attempt() Application.ScreenUpdating = False Dim s1 As Worksheet, s2 As Worksheet Set s1 = Sheets("Raw Data") Set s2 = Sheets("BAS Linkage Master") Dim i As Integer Dim j As Integer Dim Proj_ID As String Dim Lookup_Range As Range Dim Linkage_Lookup_Range As Range Dim Raw_Percent_Complete As String Dim Linkage_Percent_Complete As String Set Lookup_Range = s1.Range("A1:O1000") Set Linkage_Lookup_Range = s2.Range("A6:N1000") For i = 2 To 1000 Proj_ID = s1.Range("F" & i).Value Raw_Percent_Complete = Application.WorksheetFunction.VLookup(Proj_ID, Lookup_Range, 10, False) Next For j = 7 To 1000 Linkage_Percent_Complete = s2.Range("I" & j).Value Next If Raw_Percent_Complete = Linkage_Percent_Complete Then ' DO NOT COPY THAT ROW OVER Else Percent_Complete = Range("I" & j).Value 'UPDATE PERCENT COMPLETE FOR THAT SPECIFIC PRODUCT CODE End If Sheets("Raw Data").Activate Columns("H").EntireColumn.Delete Range("A2:P1000").Select Selection.Copy Sheets("BAS Linkage Master").Activate Range("A" & Rows.Count).End(xlUp).Offset(1).Select Selection.PasteSpecial ' Sheets("Welcome").Activate ' Range("A11:O11").ClearContents Sheets("Raw Data").Activate Range("A2:N10000").ClearContents Application.CutCopyMode = False Application.ScreenUpdating = True Sheets("BAS Linkage Master").Activate End Sub 

Answer 1

这是一个很好的小脚本，可以查找差异并突出显示差异。

 Public Sub CompareSheets() Dim ws1 As Worksheet, ws2 As Worksheet Dim cell As Range, rng As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") Set rng = ws1.Range("A1:B20") For Each cell In rng Celladdress = cell.Address If cell <> ws2.Range(Celladdress) Then cell.Interior.Color = vbYellow ws2.Range(Celladdress).Interior.Color = vbYellow End If Next cell End Sub 

您可以使用相同的概念将值从一个表复制到另一个表。

 Public Sub CompareSheets() Dim ws1 As Worksheet, ws2 As Worksheet Dim cell As Range, rng As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") Set rng = ws1.Range("A1:B20") For Each cell In rng Celladdress = cell.Address If cell <> ws2.Range(Celladdress) Then ws2.Range(Celladdress).Value = ws1.Range(Celladdress).Value End If Next cell End Sub