时间戳

首页 > 解决方案 > 如何删除重复值？

excel - 如何删除重复值？

问题描述

我动态更新 A 列和 B 列中的单元格，并将每行上的两个值（使用 &）连接起来，并将值放在 C 列中。

我的目的是通过在输入两次 firstName（A 列值）和 LastName（B 列值）时检测重复名称来实现的。当我删除重复的名称，然后是第一次出现时，会弹出一个空值（在显示 msgbox 时观察到）。

有时这是一个问题，尤其是因为有时 msgbox 不会消失。即代码崩溃。

如何防止显示空值或 msgBox？我怀疑我的 if 语句有问题。

我放在工作表中的 VBA 代码

Private Sub Worksheet_Change(ByVal Target As Range)

If WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 1).Value) > 1 And _
  Target.Offset(0, 1).Value <> " " Then
    MsgBox Target.Offset(0, 1).Value & " is a Duplicate Entry" & vbNewLine & _
    " ENTER A NEW NAME", vbInformation, "Duplicate Detected"
    Target.Offset(0, 0).Value = " "
    Target.Offset(0, 0).Select
ElseIf WorksheetFunction.CountIf(Range("c1:c12"), Target.Offset(0, 2).Value) > 1 And _
  Target.Offset(0, 1).Value <> " " Then
    MsgBox Target.Offset(0, 2).Value & " is a Duplicate Entry" & vbNewLine & _
    " ENTER A NEW NAME", vbInformation, "Duplicate Detected"
    Target.Offset(0, 0).Value = " "
    Target.Offset(0, 0).Select
Else: Exit Sub
End If

End Sub

标签： excelvba

解决方案

如果我想用

-2        -1       0
ColA      ColB     ColC
First1    Last1    First1Last1
First2    Last2    First2Last2
First3    Last3    First3Last3
First4    Last4

我个人会从 ColC 的条件格式开始，以标记重复的内容，以防出现问题，从而绕过消息框。

如果我确实需要一个消息框，我会设置类似于您所拥有的：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns(3)) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Application.CountIfs(Range("C1:C12"),Target.Value) > 1 Then 'checks for first/last name
        MsgBox("The name " & Target.Offset(0,-2).Value & " " & Target.Offset(0,-1).Value & " already exists." & vbNewLine & "Please enter a new name.")
    End If
End Sub

编辑1：

鉴于 colA 和 colB 的数据输入，这是否更合适？我利用了目标的行，所以负偏移量不应该被关注，因为你知道 colA 是名字，而 colB 是姓氏。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Dim r as long
    r = target.row
    If isempty(cells(r,1)) or isempty(cells(r,2)) then exitsub
    If Application.CountIfs(Range("B1:B12"),cells(r,2).Value,Range("A1:A12"),cells(r,1).Value) > 1 Then 'checks for first/last name
        MsgBox("The name " & cells(r,1).Value & " " & cells(r,2).Value & " already exists." & vbNewLine & "Please enter a new name.")
    End If
End Sub

编辑2：

在验证没有值和某些值的使用时，这个宏一直在为我的测试工作（我添加了清晰的内容和 .select 所以你回到了你应该添加数据的行）；我还添加了与相交相关的范围规范，以防您将诸如 first/last 之类的值添加到 a1:b12 之外的随机位置：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range(Cells(1, 1), Cells(12, 2))) Is Nothing Then Exit Sub
    Dim r As Long
    r = Target.Row
    If IsEmpty(Cells(r, 1)) Or IsEmpty(Cells(r, 2)) Then Exit Sub
    If Application.CountIfs(Range("B1:B12"), Cells(r, 2).Value, Range("A1:A12"), Cells(r, 1).Value) > 1 Then 'checks for first/last name
        MsgBox ("The name " & Cells(r, 1).Value & " " & Cells(r, 2).Value & " already exists." & vbNewLine & "Please enter a new name.")
        Cells(r, 1).ClearContents
        Cells(r, 2).ClearContents
        Cells(r, 1).Select
    End If
End Sub

推荐阅读