如何实现Excel下拉选品的重复商品数量累加而非重复添加？

核心思路 #

先检查目标列表中是否已存在当前选中的商品：

• 存在则对应计数+1
• 不存在则新增商品条目并初始化计数为1

修改后的代码 #

方案1：分两列存储（更易维护） #

假设用B列存商品名称，C列存带计数的显示内容，逻辑清晰，后续统计或修改更方便：

Dim ProductsSheet As Worksheet
Dim Product As String
Dim foundCell As Range
Dim lastRow As Long

' 替换为你的实际工作表和下拉列表单元格
Set ProductsSheet = ThisWorkbook.Worksheets("你的工作表名")
Product = Range("A1").Value ' 这里改成你的下拉列表单元格地址

With ProductsSheet
    lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    ' 在B列查找已有商品
    Set foundCell = .Range("B2:B" & lastRow).Find(What:=Product, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not foundCell Is Nothing Then
        ' 找到商品，更新计数
        Dim currentCount As Integer
        currentCount = Mid(.Cells(foundCell.Row, "C").Value, InStr(.Cells(foundCell.Row, "C").Value, "(") + 1, Len(.Cells(foundCell.Row, "C").Value) - InStr(.Cells(foundCell.Row, "C").Value, "(") - 1)
        .Cells(foundCell.Row, "C").Value = Product & "(" & currentCount + 1 & ")"
    Else
        ' 未找到商品，新增条目
        lastRow = lastRow + 1
        .Cells(lastRow, "B").Value = Product
        .Cells(lastRow, "C").Value = Product & "(1)"
    End If
End With

方案2：同一列直接显示（紧凑布局） #

如果希望直接在一列（比如原代码的C列）显示商品名(计数)，无需额外存储列：

Dim ProductsSheet As Worksheet
Dim Product As String
Dim foundCell As Range
Dim lastRow As Long
Dim existingName As String

Set ProductsSheet = ThisWorkbook.Worksheets("你的工作表名")
Product = Range("A1").Value ' 替换为你的下拉列表单元格

With ProductsSheet
    lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    ' 遍历已有条目匹配商品名
    For Each foundCell In .Range("C2:C" & lastRow)
        existingName = Left(foundCell.Value, InStr(foundCell.Value, "(") - 1)
        If existingName = Product Then
            ' 更新计数
            Dim currentCount As Integer
            currentCount = Mid(foundCell.Value, InStr(foundCell.Value, "(") + 1, Len(foundCell.Value) - InStr(foundCell.Value, "(") - 1)
            foundCell.Value = Product & "(" & currentCount + 1 & ")"
            Exit Sub ' 匹配到后直接退出循环
        End If
    Next foundCell
    
    ' 未匹配到，新增条目
    lastRow = lastRow + 1
    .Cells(lastRow, "C").Value = Product & "(1)"
End With

注意事项 #

• 替换代码中的你的工作表名和下拉列表单元格地址为实际值
• 若列表第一行是表头，代码中的起始行（比如B2）无需修改；若无表头，改成B1即可

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