比较列中的单元格对是否存在重复项 Excel VBA

Question

你好，

提前感谢您的帮助

我在下面使用此代码在列中查找匹配值。 我正在寻求帮助以执行以下操作：

下面的代码一次比较列中的所有单元格以查找从单元格 B3 开始并向下的匹配值，然后突出显示所有匹配的单元格。 代码工作正常。 但是，相反，我需要成对检查重复项，一次比较两个单元格而不是整个列，并且还需要从列中的底部单元格开始到顶部以相反的列顺序。

匹配过程的示例是：比较单元格 B10 = B9（如果它们匹配，则突出显示两者，如果不匹配，则移至下一对进行检查，B9 = B8，B8 = B7，依此类推）

Dim rg As Range

Set rg = Range("B3", Range("B3").End(xlDown))

Dim uv As UniqueValues

Set uv = rg.FormatConditions.AddUniqueValues

uv.DupeUnique = xlDuplicate

uv.Interior.Color = vbRed

谢谢

Answer 1

首先你需要一个循环，让你更好地控制 Excel 正在做什么。 像这样循环你想要的范围：

For Each cell In rg

Next cell

但是往后退到 go 就更难了。 您必须获得范围内的最高和最低行号，并通过它们执行第 1 步。

for a = rg_highestrow to rg_lowestRow step -1


next

问题是，这不知道您使用的是什么列。 The.range object 会让事情变得复杂。 因此，编写一个方法来接受您想要执行的 col 的参数，以及开始行和结束行的参数。 像这样：

sub find_duplicates(byval colnumber as integer, byval startrow as integer, byval endrow as integer)


end sub

然后您可以使用步骤 -1 向后循环：

for a = endrow to startrow step -1

next

您将需要逻辑来发现当前单元格和另一个单元格之间的重复项。 为此，请参阅“上一个单元格”。 这意味着，您想在第二行而不是第一行开始循环。 像这样：

for a = (endrow-1) to startrow step -1

next

如果您的范围内只有一行，这将不起作用。 所以测试你的范围是否只有一行。 如果只有一个，则无法进行比较，因此退出。 到目前为止，把它们放在一起：

sub find_duplicates(byval colnumber as integer, byval startrow as integer, byval endrow as integer)

    if endrow-startrow<1 then exit sub 'Needs at least 2 rows to function. Exit.

    for row_a = (endrow-1) to startrow step -1   'Loop backwards using step-1, but stop short of the very last item.
        'Do the comparison of row_a and row_a+1
        if Cells(row_a,colnumber).Value = Cells(row_a+1,colnumber).Value then
            'They match. Do whatever you need to do

        end if
    next

end sub

你可以这样称呼它：

find_duplicates(2,10,20)

这将从第 20 行到第 10 行搜索指定的列，比较行的单元格对以查找重复值。

Answer 2

下面的代码运行良好。

偏移公式中的 -1 帮助我将当前单元格与前一个单元格进行比较（如相反顺序）

Dim rngMyCell As Range
    Dim wsMySheet As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsMySheet = ActiveSheet

    For Each rngMyCell In wsMySheet.Range("F3:F" & wsMySheet.Range("F" & Rows.Count).End(xlUp).Row)
        If Val(rngMyCell.Offset(-1, 0)) = Val(rngMyCell) Then
            wsMySheet.Range("F" & rngMyCell.Row & ":F" & rngMyCell.Row).Interior.Color = RGB(255, 255, 0)
        Else
            wsMySheet.Range("F" & rngMyCell.Row & ":F" & rngMyCell.Row).Interior.Color = xlNone
        End If
    Next rngMyCell
    
    Set wsMySheet = Nothing
    
    Application.ScreenUpdating = True