比較並替換excel vba宏中的列值

Question

我想根據第一列值將「主」工作表與「新建」工作表進行比較。如果在「新建」工作表中可用，那麼我想比較「主」工作表的匹配行的列「E」與「新建」工作表的匹配行的列「E」。如果有任何差異，則將「主」的列值「E」替換爲「新」的列值「E」，並按顏色突出顯示整行。

Sub CompareValues() 
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr As Long, rng As Range, c As Range 
Set sh1 = Sheets("New") 
Set sh2 = Sheets("Master") 
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row 'Get last row with data in Column A on Sheet 1. 
Set rng = sh2.Range("A2:A" & lr) 'Set compare range to a variable 
For Each c In rng 'Make cell by cell comparison 
    If Application.CountIf(sh1.Range("A:A"), c.Value) <> 0 Then 
     If c.EntireRow.Range("E") <> sh1.Range("E", c.Value) Then 
      ' to fill the value into another sheet simply replace from sh1 to c.Range     
      c.Range("E" & i).Copy (sh1.Range("E" & i)) 
      Range(c, sh2.Cells(c.Row, Columns.Count).End(xlToLeft)).Interior.ColorIndex = 4 
     End If 
    End If 
Next 
End Sub 

Answer 1

我更新您的解決方案，以滿足我的要求。謝謝你的幫助。

Sub UpdateSheet() 
Dim masterSheet As Excel.Worksheet, newSheet As Excel.Worksheet 
Dim e, n, masterCell As Excel.Range, newCell As Excel.Range 
Dim columnOffset As Integer 

Const idColumn = 1 'column A has index 1 
Const newDataColumn = 5 'column E has index 5 
columnOffset = newDataColumn - idColumn 'offset between those columns is 4 

Set masterSheet = ThisWorkbook.Sheets("Master") 
Set newSheet = ThisWorkbook.Sheets("New") 

'iterate over all cells of the first column in the used range of this worksheet 
For Each e In masterSheet.UsedRange.Columns(idColumn).Cells 
    Set masterCell = e 
    If masterCell.Value <> Empty Then 
     For Each n In newSheet.UsedRange.Columns(idColumn).Cells 
      Set newCell = n 

      'if the cell on the master sheet is not empty and the values of both cells match 
      If masterCell.Value = newCell.Value Then 
       'select cells in column "E" 
       Set masterCell = masterCell.Offset(0, columnOffset) 
       Set newCell = newCell.Offset(0, columnOffset) 

       'copy values and paint row if values don't match 
       If masterCell.Value <> newCell.Value Then 
        masterCell.Value = newCell.Value 
        masterCell.EntireRow.Interior.ColorIndex = 4 
       End If 
      End If 
     Next n 
    End If 
Next e 

End Sub 

Answer 2

可惜我不能在這個問題上（或交照片）評論...

爲了澄清（假設我的第三列是列 'E'）：

如果表「大師」是這樣的：

| first | info | d'oh | 
| two | info | 4 | 
| three | info | hello | 

和 「新」 的模樣說：

| first | info | d'oh | 
| two | blub | 5 | 
| wheee | cool | cool | 

你想要的結果：

| first | info | d'oh | 
| two | info | 5 | <- highlighted 
| three | info | hello | 

---

我的解決辦法：

Sub UpdateSheet() 
    Dim masterSheet As Excel.Worksheet, newSheet As Excel.Worksheet 
    Dim e, masterCell As Excel.Range, newCell As Excel.Range 
    Dim columnOffset As Integer 

    Const idColumn = 1 'column A has index 1 
    Const newDataColumn = 5 'column E has index 5 
    columnOffset = newDataColumn - idColumn 'offset between those columns is 4 

    Set masterSheet = ThisWorkbook.Sheets("Master") 
    Set newSheet = ThisWorkbook.Sheets("New") 

    'iterate over all cells of the first column in the used range of this worksheet 
    For Each e In masterSheet.UsedRange.Columns(idColumn).Cells 
     Set masterCell = e 
     Set newCell = newSheet.Cells(masterCell.Row, idColumn) 

     'if the cell on the master sheet is not empty and the values of both cells match 
     If masterCell.Value <> Empty And masterCell.Value = newCell.Value Then 
      'select cells in column "E" 
      Set masterCell = masterCell.Offset(0, columnOffset) 
      Set newCell = newCell.Offset(0, columnOffset) 

      'copy values and paint row if values don't match 
      If masterCell.Value <> newCell.Value Then 
       masterCell.Value = newCell.Value 
       masterCell.EntireRow.Interior.ColorIndex = 4 
      End If 
     End If 
    Next e 

End Sub