☰

如何检查列中的重复值

tag-icon • tag-icon microsoft-excel vba macros
如何检查列中的重复值

你好，我使用下面的代码将我的 D 列值与从 5 到 9 的其他列进行比较，以查找重复项，如果有重复项则将其标记为红色，这样就可以了。

但是我该如何检查第 5 列到第 9 列的值是否重复，如果重复，也将它们标记为红色

For col = 5 To 9
TempTest = Ws.Cells(x, col).Value

    If TempTest <> "" Then
       Test = Right(TempTest , Len(TempTest ) - InStrRev(TempTest , ":"))
       Ws.Cells(x, col).Value = Test 
        If Ws.Cells(x, col).Value = Ws.Range("D" & x).Value Then
            Ws.Range("A" & x & ":I" & x).Interior.ColorIndex = 3
            y = y + 1
        End If

    End If
Next col

答案1

如果没有数据样本，就很难确切地知道您想要什么，但是根据您的代码和您编写的文本，我认为这是正确的：

Option Base 1 'this needs to be at the top of the module
Sub chkdup()
        Application.ScreenUpdating = False
        Dim Chkarr As Variant
        Dim ws1 As Sheet1: Set ws1 = Sheet1
        Dim StartofTable As String, TStr As String
        Dim SRw As Long, SCol As Long, x As Long, y As Long
        StartofTable = "D13" 'enter first cell of table
        Chkarr = ws1.Range(StartofTable).CurrentRegion
        SRw = ws1.Range(StartofTable).Row - 1
        SCol = ws1.Range(StartofTable).Column - 1
        For x = LBound(Chkarr, 2) To UBound(Chkarr, 2)
            For y = LBound(Chkarr, 1) To UBound(Chkarr, 1)
                If InStrRev(Chkarr(y, x), ":") > 0 Then
                    TStr = Right(Chkarr(y, x), Len(Chkarr(y, x)) - InStrRev(Chkarr(y, x), ":"))
                Else
                    TStr = Chkarr(y, x)
                End If
                For i = LBound(Chkarr, 2) To UBound(Chkarr, 2)
                    For j = LBound(Chkarr, 1) To UBound(Chkarr, 1)
                        If x = i And y = j Then GoTo NxtJ
                        If InStr(Chkarr(j, i), ":") > 0 Then
                            If TStr = Right(Chkarr(j, i), Len(Chkarr(j, i)) - InStrRev(Chkarr(j, i), ":")) Then _
                            ws1.Cells(j + SRw, i + SCol).Interior.Color = vbRed
                        Else
                            If Chkarr(j, i) = TStr Then ws1.Cells(j + SRw, i + SCol).Interior.Color = vbRed
                        End If
    NxtJ:
                    Next j
                Next i
            Next y
        Next x
        Application.ScreenUpdating = True
    End Sub

更改 StartofTable = "D13" 以反映表格的第一个单元格，它应该处理其余部分（它假设表格中没有整个空白行或整个空白列（即有一个连续的范围）。代码将突出显示整个表格中的任何重复项，我将分隔符“：”作为一个选项包含在您的代码中。

请注意，Option Base 1 这一行需要位于模块的顶部。

前后结果如下所示：

在此处输入图片描述

答案2

试试这个代码：

在此处输入图片描述

Private Sub CommandButton1_Click()

Dim sh As Worksheet, lr As Long, fVal As Range, c As Range
    
    Set sh = Sheets(3)
    
    lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
        
        For Each c In sh.Range("a3:a8")
            
            Set fVal = sh.Range("b3:d" & lr).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
                
                If Not fVal Is Nothing Then
                    fAdr = fVal.Address
                    Do
                    fVal.Interior.ColorIndex = 3
                    fVal.Value = c.Value
                    Set fVal = sh.Range("b3:d" & lr).FindNext(fVal)
                    Loop While fVal.Address <> fAdr
                End If
        
        Next

End Sub

注意：

  • 我使用命令按钮来应用 VBA 代码，您可以使用简单的程序。
  • 在此 VBA 代码中，工作表名称、数据范围和颜色索引是可调整的，请根据需要进行修改。
  • 如果您还想突出显示 A 列，则请将其更改 sh.Range("b3:d" & lr)为sh.Range("A3:d" & lr)。
  • 将工作簿保存为启用宏*.xlsm。

相关内容