求助：Excel中不删除重复项，为客户名添加序号的VBA解决方案

以下是针对B列重复客户名添加序号的VBA代码，可高效完成批量处理，且不修改原数据（结果输出到C列）：

Sub AddDuplicateSuffix()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim customerDict As Object
    Dim i As Long
    Dim customerName As String
    Dim count As Integer
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.count, "B").End(xlUp).Row
    Set customerDict = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        customerName = Trim(ws.Cells(i, "B").Value)
        If customerName <> "" Then
            If customerDict.Exists(customerName) Then
                customerDict(customerName) = customerDict(customerName) + 1
                count = customerDict(customerName)
                ws.Cells(i, "C").Value = customerName & count
            Else
                customerDict(customerName) = 1
                ws.Cells(i, "C").Value = customerName
            End If
        End If
    Next i
    
    Set customerDict = Nothing
    MsgBox "处理完成！带序号的客户名已输出到C列。"
End Sub

代码说明 #

• 采用Scripting.Dictionary统计客户出现次数，仅需遍历一次数据，处理效率远高于重复查找
• 默认从第2行开始处理（假设第1行是表头），若数据无表头，将For i = 2 To lastRow改为For i = 1 To lastRow
• 自动跳过B列空单元格，避免无效处理
• 结果输出到C列，保留原B列数据的完整性

使用步骤 #

1. 打开目标Excel文件，按Alt + F11打开VBA编辑器
2. 右键点击左侧工作簿名称 → 插入 → 模块
3. 将上述代码粘贴到模块窗口中
4. 返回Excel界面，按Alt + F8，选择AddDuplicateSuffix宏并执行

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