比较一列中重复的单元格对 Excel VBA

如何解决比较一列中重复的单元格对 Excel VBA

你好

提前感谢您的帮助

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

下面的代码一次比较列中的所有单元格以匹配从单元格 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

谢谢

解决方法

首先，您需要一个循环，以便更好地控制 Excel 正在执行的操作。像这样循环你想要的范围：

For Each cell In rg

Next cell

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

for a = rg_highestrow to rg_lowestRow step -1


next

问题是，它不知道您使用的是哪个列。 .range 对象会使事情变得复杂。因此，编写一个方法，该方法接受您想要执行的列以及起始行和结束行的参数。像这样：

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 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 行的指定列，比较行的单元格对是否有重复值。

以下代码运行良好。

偏移公式中的 -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