根据列A中的匹配索引replace列C中的string

我将不胜感激在这个问题上的任何帮助。 我正在尝试在VBA中创build一个Excel 2010macros，它将逐行读取一个电子表格中的string，然后search另一个电子表格以查看该值是否存在于一列string中。

如果/当它在列A中find匹配的string时，我想比较原始电子表格的C列中的string与正在search的电子表格的C列中的string。 如果两个string是相同的，我想回到列search并继续。

如果string不同，我想覆盖正在search的电子表格的C列中的string。 我还想在search的电子表格中突出显示这一更改。

如果在search电子表格的A列中找不到匹配的string，那么我想将原始电子表格的行复制到search的电子表格中并突出显示。

这是我到目前为止，但我似乎无法得到它正常工作：

Sub SearchRows() Dim bottomA1 As Integer bottomA1 = Sheets("Original Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row Dim bottomA2 As Integer bottomA2 = Sheets("Searched Spreadsheet").Range("A" & Rows.Count).End(xlUp).Row Dim rng1 As Range Dim rng2 As Range Dim x As Long Dim y As Long Dim foundColumnA As Range Dim foundColumnC As Range For Each rng1 In Sheets("Original Spreadsheet").Range("A2:A" & bottomA1) With Sheets("Searched Spreadsheet").Range("A2:A" & bottomA2) Set foundColumnA = .Find(what:=rng1, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) For Each rng2 In Sheets("Original Spreadsheet").Range("E2:E" & bottomA1) With Sheets("Searched Spreadsheet").Range("E2:E" & bottomA2) Set foundSize = .Find(what:=rng2, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=True) If foundColumnC Is Nothing Then bottomE2 = Sheets("Column C Changes").Range("E" & Rows.Count).End(xlUp).Row y = bottomA2 + 1 rng2.EntireRow.Copy Sheets("Column C Changes").Cells(y, "A") Sheets("Column C Changes").Cells (y, "A").EntireRow.Interior.ColorIndex = 4 End If End With Next rng2 If foundTag Is Nothing Then bottomA2 = Sheets("Column A Changes").Range("A" & Rows.Count).End(xlUp).Row x = bottomA2 + 1 rng1.EntireRow.Copy Sheets("Column A Changes").Cells(x, "A") Sheets("Column A Changes").Cells(x, "A").EntireRow.Interior.ColorIndex = 3 End If End With Next rng1 End Sub 

Answer 1

你实际上有太多的代码，但是它们没有被清理干净。 尽可能地限定许多事物，使其更清洁，并尽量与自己的风格保持一致。 这样你可以尽可能的识别错误。

无论如何，在代码。 你想要的基本逻辑如下，基于上面的细节：

1. 检查Sheet1!A的string是否在Sheet2!A 。
2. 如果find，比较Column C值。
   • 如果Column C值不同，请将Sheet2值设置为Sheet1值，然后突出显示。
   • 否则，退出。
3. 如果找不到，则将整行复制到Sheet2并突出显示。

现在我们已经写下来了，这很简单！ 🙂

请检查我的设置的截图：

截图：

工作表Sheet1：

Sheet2中：

请注意，对于Sheet2 ，我没有BK207 。 ;）现在，到代码。

码：

 Sub LoopMatchReplace() Dim ShSrc As Worksheet, ShTar As Worksheet Dim SrcLRow As Long, TarLRow As Long, NextEmptyRow As Long Dim RefList As Range, TarList As Range, RefCell As Range, RefColC Dim TarCell As Range, TarColC As Range Dim IsFound As Boolean Dim ToFind As String With ThisWorkbook Set ShSrc = .Sheets("Sheet1") Set ShTar = .Sheets("Sheet2") End With 'Get the last rows for each sheet. SrcLRow = ShSrc.Range("A" & Rows.Count).End(xlUp).Row TarLRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row 'Set the lists to compare. Set RefList = ShSrc.Range("A2:A" & SrcLRow) Set TarList = ShTar.Range("A2:A" & TarLRow) 'Initialize boolean, just for kicks. IsFound = False 'Speed up the process. Application.ScreenUpdating = False 'Create the loop. For Each RefCell In RefList ToFind = RefCell.Value 'Look for the value in our target column. On Error Resume Next Set TarCell = TarList.Find(ToFind) If Not TarCell Is Nothing Then IsFound = True On Error GoTo 0 'If value exists in target column... If IsFound Then 'Compare the Column C of both sheets. Set TarColC = TarCell.Offset(0, 2) Set RefColC = RefCell.Offset(0, 2) 'If they are different, set the value to match and highlight. If TarColC.Value <> RefColC.Value Then TarColC.Value = RefColC.Value TarColC.Interior.ColorIndex = 4 End If Else 'If value does not exist... 'Get next empty row, copy the whole row from source sheet, and highlight. NextEmptyRow = ShTar.Range("A" & Rows.Count).End(xlUp).Row + 1 RefCell.EntireRow.Copy ShTar.Rows(NextEmptyRow) ShTar.Rows(NextEmptyRow).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 3 End If 'Set boolean check to False. IsFound = False Next RefCell Application.ScreenUpdating = True End Sub 

请阅读代码块的评论，以便了解我在做什么。 另外，请注意我所有的资格，并以一种非常干净的方式妥善设置它们。 干净的代码是50％的好代码。

检查以下屏幕截图，查看运行代码后的结果。

最终结果：

注意最后添加的行和列C中的改变的值。我没有突出显示整行，因为我认为这是不好的做法和混乱，但是你应该改变相应的行和值以适合你的口味最终结果。

让我们知道这是否有帮助。

Answer 2

我想你可以使用这个代码。 未find的值将被添加到目标工作表的末尾。 差异是用蓝色（如果你想要改变）背景色签署的。

 Sub copy_d() Dim r1 As Long, rfound, vfound Dim w1, w2, v, lastR As Long, lastC As Long Set w1 = Sheets("sheet1") ' change the origin sheet at will Set w2 = Sheets("sheet2") ' change the destination sheet at will r1 = 1 ' assuming data start in row 1, change it if not Do While Not IsEmpty(w1.Cells(r1, 1)) v = w1.Cells(r1, 1) rfound = Application.Match(v, w2.Columns(1), 0) ' look for value If Not IsError(rfound) Then ' found it? vfound = w2.Cells(rfound, 3) If w1.Cells(r1, 3) <> vfound Then ' value in column C is different? w2.Cells(rfound, 3) = w1.Cells(r1, 3) ' update based on origin sheet lastC = w2.Cells(rfound, 1).End(xlToRight).Column w2.Range(w2.Cells(rfound, 1), w2.Cells(rfound, lastC)).Interior.ColorIndex = 5 End If Else lastR = w2.Cells(1, 1).End(xlDown).Row + 1 w1.Rows(r1).copy Destination:=w2.Rows(lastR) ' copy to last row of dest sheet lastC = w2.Cells(lastR, 1).End(xlToRight).Column w2.Range(w2.Cells(lastR, 1), w2.Cells(lastR, lastC)).Interior.ColorIndex = 5 End If r1 = r1 + 1 Loop End Sub