Servus Martin,
hab Dir mal was geschrieben und verständnishalber auskommendiert.
Nimm den Code und kopiere in in ein neues Modul.
Makiere dann die Zelle in der der zu suchenende Artikel steht. Starte dann das Makro und
gebe bei der Anfrage nach der Spalte die Spalte als Zahl an in der die zu addierenden Preise stehen.
Im Anschluß werden alle Werte addiert und die Zeilen mit Duplikaten gelöscht
Option Base 1
Sub Arikel_Suchen()
Dim Gz As Long
Dim such_Begriff As Variant
Dim such_Sp As Integer
Dim suchsaMmel() As Integer
Dim aDdierer As Variant
Dim spalTe_Plus As Integer
Dim wie_Häufig As Integer
Dim hilf_Index As Integer
spalTe_Plus = InputBox("Die Werte welcher Spalte sollen addiert werden" & Chr(10) & _
"Gib die Spalte als Zahl an!!!")
If IsNumeric(spalTe_Plus) = False Then
MsgBox ("Der von Ihnen eingegeben Wert enthält keine Zeichen oder ist keine Zahl")
Exit Sub
End If
such_Sp = ActiveCell.Column
such_Begriff = ActiveCell.Value
Gz = Cells(Rows.Count, such_Sp).End(xlUp).Row
For a = 1 To Gz
If Cells(a, such_Sp) = such_Begriff Then
wie_Häufig = wie_Häufig + 1
End If
Next a
If wie_Häufig = 1 Or wie_Häufig = 0 Then
MsgBox ("Es wurde nur ein Datensatz mit Ihren Angaben gefunden")
Exit Sub
End If
ReDim suchsaMmel(wie_Häufig)
hilf_Index = 1
For a = 1 To Gz
If Cells(a, such_Sp) = such_Begriff Then
suchsaMmel(hilf_Index) = a
hilf_Index = hilf_Index + 1
End If
Next a
If wie_Häufig = 1 Or wie_Häufig = 0 Then
MsgBox ("Es wurde nur ein Datensatz mit Ihren Angaben gefunden")
Exit Sub
Else
Cells(suchsaMmel(1), spalTe_Plus).Activate
aDdierer = Cells(suchsaMmel(1), spalTe_Plus).Value
For c = hilf_Index - 1 To 2 Step -1
aDdierer = aDdierer + Cells(suchsaMmel(c), spalTe_Plus).Value
Cells(suchsaMmel(c), such_Sp).EntireRow.Delete
Next c
Cells(suchsaMmel(1), spalTe_Plus).Value = aDdierer
End If
End Sub