Question

Excel vba如何使用宏实现：判断A列数据是否重复，如果重复，在B列显示重复，如果不重复，则在

Excel vba如何使用宏实现：判断A列数据是否重复，如果重复，在B列显示重复，如果不重复，则在B列显示唯一？

Answer 1

如果用代码：
Dim myBoo As Boolean
myBoo = True
Dim I As Long, C As Long
C = Application.WorksheetFunction.CountA(Range("A:A"))
For I = 1 To C
If Range("B" & I).Value <> Application.WorksheetFunction.VLookup(Range("A" & I).Value, Range("A:B"), 2, 0) Then myBoo = False: Exit For
Next
If myBoo Then
MsgBox "正常"
Else
MsgBox "异常"
End If

Answer 2

Sub test()
    Dim arr, brr()
    Dim I As Integer, j As Integer
    Dim Dict As Object

    On Error Resume Next
    Set Dict = CreateObject("scripting.dictionary")
    With ActiveSheet
        arr = Intersect(.UsedRange, .Columns(1))

        For I = 1 To UBound(arr)
            If Dict.exists(arr(I, 1)) Then
                Dict.Item(arr(I, 1)) = Dict.Item(arr(I, 1)) + 1
            Else
                Dict.Item(arr(I, 1)) = 1
            End If
        Next I

        For I = 1 To UBound(arr)
            j = j + 1
            ReDim Preserve brr(1 To j)
            brr(j) = IIf(Dict.Item(arr(I, 1)) = 1, "唯一", "重复")

        Next I
        .Columns(2).ClearContents
        .Range("b1").Resize(UBound(brr), 1) = WorksheetFunction.Transpose(brr)
    End With
  
End Sub

追问

语句好长，数据量8万左右，运行会不会慢？

追答

Sub test()
    Application.ScreenUpdating = False
    Dim arr, brr()
    Dim i As Long, j As Long
    Dim Dict As Object
    On Error Resume Next

    Set Dict = CreateObject("scripting.dictionary")

    With ActiveSheet
        arr = Intersect(.UsedRange, .Columns(1))
        ReDim brr(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr)
            If Dict.exists(arr(i, 1)) Then
                Dict.Item(arr(i, 1)) = Dict.Item(arr(i, 1)) + 1
            Else
                Dict.Item(arr(i, 1)) = 1
            End If
        Next i

        For i = 1 To UBound(arr)
            j = j + 1
            brr(j, 1) = IIf(Dict.Item(arr(i, 1)) = 1, "唯一", "重复")

        Next i
        .Columns(2).ClearContents
        .Range("b1").Resize(UBound(brr), 1) = brr
    End With
    Application.ScreenUpdating = True
End Sub

我电脑运行了1.3秒

追问

给跪了！如果从第二行开始，表头不包括，怎么改？另外，如果判断由A、B换到C、D，怎么改？

Answer 3

一定要在B列显示么？ excel有一个功能叫显示重复值。
我的excel是2013版本，全选A列，然后选开始->条件格式->突出显示单元格规则->重复值。重复值会表红。

追问

嗯，需要反馈结果。

Answer 4

取不重复值，VBA中通常都是使用字典法

追问

咋做？