Excel 如果在同一列中输入了重复值，是否自动对数量求和？

对于数据输入，我有一个范围A1:B10，其中A1:A10表示项目名称，B1:B10表示数量。 我需要VBA，如果我在A1:A10范围内输入了相同的项目名称，它们会自动合计B1:B10范围内的数量，并删除输入的重复值

选项显式
私有子工作表_更改（ByVal目标作为范围）
'更改项目时，如果找到行并添加到收据
如果不相交（目标，范围（“E10”）为空，范围（“E10”）。值为空，则添加项
'更改添加项目的价格或数量时
如果不相交（目标，范围（“F8，F6”）为空，范围（“B4”）。值=假，范围（“B6”）。值为空，则
暗淡的记录，如长
RecptRow=范围（“B6”）。值“接收行”
如果不相交（目标，范围（“F6”）为零，则范围（“M”和RecptRow）。值=目标。值“更新价格”
如果不相交（目标，范围（“F8”）为零，则范围（“L”和RecptRow）。值=目标。值“更新数量”
如果结束
端接头

像这样的东西应该可以用

Private Sub Worksheet_Change(ByVal Target As Range)

lastRow = Range("A" & Rows.Count).End(xlUp).Row ' or whatever other method used to determine lastrow

For Each xTarget In Target
 If xTarget.Row = lastRow And xTarget.Column = 2 Then 'if B4 was changed
     Call addIt(item:=Cells(xTarget.Row, xTarget.Column - 1), xTarget:=xTarget) ' passing in just xTarget so can use the value and the row

 
End If

Next xTarget
End Sub

Sub addIt(item, xTarget)

For x = 1 To xTarget.Row - 1 ' minus one because obviously dont wanna check the value you just now entered
  If LCase(Trim(Cells(x, "A"))) = LCase(Trim(item)) Then ' lcase and trim to allow for whitespaces and case insensitivity
      Cells(x, "B") = Cells(x, "B") + xTarget.value
    
    'now will blank out if added to upper item
      Application.EnableEvents = False
      Cells(xTarget.Row, xTarget.Column) = "" 'b lr
      Cells(xTarget.Row, xTarget.Column - 1) = "" 'a lr
      Cells(xTarget.Row, xTarget.Column - 1).Activate 'a lr.activate

      Application.EnableEvents = True

      Exit Sub 'stop looping and get out

End If
Next x

End Sub

我对Target中的每个xTarget使用一个，以防您一次修改多个单元格（删除某些内容），这样它就不会抛出错误

如果更改了lastrow列b，则会触发addIt子列 然后它禁用事件，这样如果我们将lastrow列b和a设置为空，就不会进入无限循环

---

如果您对此答案有更多问题，请添加评论！如果这回答了您的问题，请标记为已回答

是的，您可以使用VBA执行此操作，请查看

工作表更改

事件。先生，如果可能，您能否为此提供完整的VBA代码？提前谢谢你…Stack Overflow不是一个代码编写服务，它是一个问答网站，有相当严格的规则和节制。这里是在这个网站上。需要努力解决这个问题，特别是您正在努力解决的问题。保留所有行并使用透视表？先生，如果可能，请提供vba。您是天才Josh Pachner先生。但我不需要只为一个范围（“B4”）。我希望这适用于范围内的所有单元格（“B1:B10”）。若A1:A5是唯一数据，那个么可以，但当我在A5之后从上面的唯一值写入重复数据时，它应该被添加到上面的值。不仅适用于单电池A4或B4。您的代码运行得很好，但只适用于A4到B4。嘿，sumit，这是因为if语句xtarget.row=4和xtarget.column=2，然后。。。。您需要动态地更改语句的类型。可能是通过检查它是否是firstHey Sumit的最后一行，我只是做了一些更改，以允许它增长。通过查找最后一行，然后检查最后一行是否是已更改的单元格，这将触发addIt sub。如果找到该值，它将添加该值，然后清空已添加的单元格。如果找不到，那么它将使输入的项目-值对处于孤立状态不可置信、不可想象的状态，因为您为世界提供了唯一的VBA代码。非常感谢，先生。脱帽致敬。谢谢库马尔，请接受我的回答

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'On change of item, if Row found and add to receipt
If Not Intersect(Target, Range("E10")) Is Nothing And Range("E10").Value <> Empty Then AddItem

'On Change of Price Or Qty For Added Items
If Not Intersect(Target, Range("F8,F6")) Is Nothing And Range("B4").Value = False And Range("B6").Value <> Empty Then
    Dim RecptRow As Long
    RecptRow = Range("B6").Value 'Receipt Row
    If Not Intersect(Target, Range("F6")) Is Nothing Then Range("M" & RecptRow).Value = Target.Value 'Update Price
     If Not Intersect(Target, Range("F8")) Is Nothing Then Range("L" & RecptRow).Value = Target.Value 'Update Qty
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

lastRow = Range("A" & Rows.Count).End(xlUp).Row ' or whatever other method used to determine lastrow

For Each xTarget In Target
 If xTarget.Row = lastRow And xTarget.Column = 2 Then 'if B4 was changed
     Call addIt(item:=Cells(xTarget.Row, xTarget.Column - 1), xTarget:=xTarget) ' passing in just xTarget so can use the value and the row

 
End If

Next xTarget
End Sub

Sub addIt(item, xTarget)

For x = 1 To xTarget.Row - 1 ' minus one because obviously dont wanna check the value you just now entered
  If LCase(Trim(Cells(x, "A"))) = LCase(Trim(item)) Then ' lcase and trim to allow for whitespaces and case insensitivity
      Cells(x, "B") = Cells(x, "B") + xTarget.value
    
    'now will blank out if added to upper item
      Application.EnableEvents = False
      Cells(xTarget.Row, xTarget.Column) = "" 'b lr
      Cells(xTarget.Row, xTarget.Column - 1) = "" 'a lr
      Cells(xTarget.Row, xTarget.Column - 1).Activate 'a lr.activate

      Application.EnableEvents = True

      Exit Sub 'stop looping and get out

End If
Next x

End Sub