找出A列中是否重复的，在B列标注出来是或者否

jeisea

自动找出A列名称中是否有重复的，并在B列标注出来，VBA该如何写，例子如下：

A             B
名称        是否重复
1             是
2             是
2             是
4             否
1             是
6             否
5             是
7             否
5             是
1             是
8             否

lsc900707

Sub lsc()
    Dim arr, brr(), d
    Set d = CreateObject("scripting.dictionary")
    With ActiveSheet
        arr = .[a1].CurrentRegion
        ReDim brr(1 To UBound(arr), 1 To 1)
        For i = 2 To UBound(arr)
            If d.exists(arr(i, 1)) Then
                d(arr(i, 1)) = d(arr(i, 1)) + 1
            Else
                d(arr(i, 1)) = 1
            End If
        Next
        For i = 2 To UBound(arr)
            j = j + 1
            brr(j, 1) = IIf(d(arr(i, 1)) = 1, "否", "是")
        Next
        .[b2:b5000].ClearContents
        .[b2].Resize(UBound(brr)) = brr
    End With
End Sub

cbm

Sub Smmry() '标记重复数据
  Dim N%, Arr '变量声明
  N = Cells(Rows.Count, 1).End(xlUp).Row '取得行数
  Arr = Application.Transpose(Range("a2:a" & N)) '数组赋值
  Range("b2:b" & N) = "否" '准备数组区域,并初始化
  For i = 1 To N - 1 '遍历所有数据
    For j = 1 To i - 1 '检查重复性
      If Arr(i) = Arr(j) Then '如有重复
        Cells(i + 1, 2) = "是": Cells(j + 1, 2) = "是" '标记
        Exit For '重复即退出嵌套循环
      End If
    Next j
  Next i
End Sub

cbm

上面代码的附件