Question

我在这里有代码形式的另一篇文章，但我似乎无法让它真正突出显示每行中的单个细胞差异。我有一张当前的纸张和一张纸张;我们的想法是代码应该比较一列中的序列号（在两个工作表中都是相同的）并做两件事：

1）如果某个值出现在“当前”工作表上，但不在“上一个”上，则“当前”工作表上的整行将突出显示为绿色。（这与当前代码一起工作）;和 2）如果两个工作表上都有匹配值，则应比较行，并将当前工作表上与上一个不同的任何值突出显示为黄色。（这不起作用）

列的数量和顺序始终相同。序列号不会更改，并且每个条目都是唯一的。我一直在看的代码是：

Sub NewUpdates()

    Const ID_COL As Integer = 31 'ID is in this column
    Const NUM_COLS As Integer = 32 'how many columns are being compared?

    Dim shtNew As Excel.Worksheet, shtOld As Excel.Worksheet
    Dim rwNew As Range, rwOld As Range, f As Range
    Dim x As Integer, Id
    Dim valOld, valNew

    Set shtNew = ActiveWorkbook.Sheets("CurrentList")
    Set shtOld = ActiveWorkbook.Sheets("PreviousList")

    Set rwNew = shtNew.Rows(5) 'first entry on "current" sheet

    Do While rwNew.Cells(ID_COL).Value <> ""

        Id = rwNew.Cells(ID_COL).Value
        Set f = shtOld.UsedRange.Columns(ID_COL).Find(Id, , xlValues, xlWhole)
        If Not f Is Nothing Then
            Set rwOld = f.EntireRow

            For x = 1 To NUM_COLS
                If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
                    rwNew.Cells.Interior.Color = vbYellow
                Else
                    rwNew.Cells.Interior.ColorIndex = xlNone
                End If
            Next x

        Else
            rwNew.EntireRow.Interior.Color = vbGreen 'new entry
        End If

        Set rwNew = rwNew.Offset(1, 0) 'next row to compare

        Loop

End Sub

我没有改变编码本身的任何内容，但我从中提取的原始讨论没有继续下去。有关更新的任何想法，以便我可以突出显示各个单元格以显示差异吗？

编辑：找到Tim Williams回答类似问题的链接，我发现了这段代码。它可以找到here。

Answer 1

如果您将将颜色更改为黄色的部分更改为此（请注意附加的“（x）”），它应该有效：

For x = 1 To NUM_COLS
    If rwNew.Cells(x).Value <> rwOld.Cells(x).Value Then
        rwNew.Cells(x).Interior.Color = vbYellow
    Else
        rwNew.Cells(x).Interior.ColorIndex = xlNone
    End If
Next x

匹配两个工作表中相同列中的值，然后比较整行的差异

1 个答案: