VBA技术问询：如何为Excel列中重复值添加标识符？

从输入截图能看到，你需要处理A列里的重复文本，给重复项添加编号来区分，但之前的循环代码没达到预期效果，下面帮你分析问题并给出可行方案：

原代码的问题 #

你的双重循环逻辑有两个关键问题：

1. 只要找到相同值就修改当前单元格并递增计数器，导致同一个单元格会被多次重复修改（比如第i行和第N行匹配时，反复触发修改操作）
2. 计数器是全局递增的，没有按每个重复值单独分组计数，没法实现同一值的重复项按自身出现顺序编号

可行实现思路 #

方法1：用字典统计重复次数（VBA实现） #

利用字典记录每个字符串的出现次数，遍历单元格时动态更新计数，给重复项加序号，数据量大时效率也很高。

代码示例：

Sub AddDuplicateID()
    Dim ws As Worksheet
    Dim cell As Range
    Dim valueDict As Object
    Dim currentVal As String
    Dim repeatCount As Integer
    
    Set ws = ThisWorkbook.Worksheets("sheet1")
    Set valueDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历A列所有非空单元格（从A1开始到最后一行有数据的单元格）
    For Each cell In ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
        currentVal = cell.Value
        If currentVal <> "" Then
            If valueDict.Exists(currentVal) Then
                valueDict(currentVal) = valueDict(currentVal) + 1
                ' 给重复项加序号，比如"香蕉"第二次出现变成"香蕉1"
                cell.Value = currentVal & valueDict(currentVal)
            Else
                valueDict(currentVal) = 0
                ' 第一次出现的保持原样，要是想统一加0，就把下面注释去掉
                ' cell.Value = currentVal & 0
            End If
        End If
    Next cell
End Sub

方法2：用Excel公式实现（无需VBA） #

如果不想写代码，直接在B列输入公式，下拉填充就能实现：

=IF(COUNTIF($A$1:A1,A1)>1,A1&COUNTIF($A$1:A1,A1)-1,A1)

逻辑：统计当前单元格及上方区域内相同值的出现次数，次数大于1时，在原字符串后加「次数-1」，否则保持原内容。

效果说明 #

两种方法都能实现：第一次出现的字符串保持原样（或按需加0），第二次及以后的重复项会在末尾加上递增的序号（1、2、3...），完美区分重复值。

内容的提问来源于stack exchange，提问作者fluervion