如何用VBA实现查找重复项并添加名称?

发布网友发布时间：2022-07-02 06:05

共2个回答

热心网友时间：2023-10-24 17:16

Option Explicit

Sub Sfind()
    Dim rng As Range, srng As Range
    Dim dic As Variant, key As Variant
    Dim i As Integer, k As Integer
    With Sheets("Sheet1") '这里选择表格
        Set srng = .[a1:a12] '这里选择要统计重复的区域
        Set dic = CreateObject("Scripting.Dictionary")
        For Each rng In srng
            If Not IsEmpty(rng.Value) Then
                If Not dic.Exists(rng.Value) Then dic.Add rng.Value, 1
            End If
        Next rng
        key = dic.keys
        For i = LBound(key) To UBound(key)
            k = 0
            For Each rng In srng
                If rng.Value = key(i) Then
                k = k + 1
                If k > 1 Then rng.Value = rng.Value & k & "号"
                End If
            Next rng
        Next i
        Set srng = Nothing
        Set dic = Nothing
    End With
End Sub

防止有什么我没有调试出来的BUG，运行前先备份数据！

热心网友时间：2023-10-24 17:16

Sub test()
Dim i%, d As Object
Set d = CreateObject("scripting.dictionary")
Sheet1.Select
For i = 36 To 47
d(Cells(i, 3).Value) = d(Cells(i, 3).Value) + 1
If d.exists(Cells(i, 3).Value) And d(Cells(i, 3).Value) > 1 Then
Cells(i, 3) = Cells(i, 3) & d(Cells(i, 3).Value) & "号"
End If
Next
set d=nothing
End Sub