Question

我想将“Master”工作表与基于第一列值的“New”工作表进行比较。如果“新”工作表中有相同的内容，那么我想比较“主”工作表的匹配行的列“E”和“新”工作表的匹配行的列“E”。如果值有任何差异，则将“master”的列值“E”替换为“New”的列值“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

不幸的是我不能评论这个问题（或发布图片）......

澄清（假设我的第三列是'E'列）：

如果“Master”表格如下：

| 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

Answer 2

我更新了您的解决方案以符合我的要求。谢谢你的帮助。

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

比较并替换excel vba宏中的列值

2 个答案: