Werte mit gleicher Auftragsnummer addieren

Public Sub Zeichenloeschung()
Dim i As Long
Dim Start As String
Dim Ende As String
Dim Temp As String
Dim erlaubt As String

erlaubt = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890,<> " ' <- hier werden die Zeichen definiert, die erlaubt sind;  
' Groß-/Kleinschreibung wird ignoriert  
Application.ScreenUpdating = False ' Bildschirm-Aktualisierung wird hier deaktiviert;  
' Ansonsten dauert der Vorgang noch ein wenig länger, da er sonst jede Änderung sofort anzeigt  
    For Each C In Selection
        With C
            Temp = ""  
            For i = 1 To Len(.Text)
                If InStr(1, erlaubt, Mid(.Text, i, 1), vbTextCompare) > 0 Then
                    Temp = Temp & Mid(.Text, i, 1)
                End If
            Next i
            .Value = Temp
        End With
        Next C
Application.ScreenUpdating = True ' Jetzt wird die Anzeige wieder aktualisiert  

End Sub

Sub Semih_Formel_fuer_Martina()
QTabelle = "Summary"                                               'Quelltabelle  
QAbZeile = 1                                                             'Überschriftenzeile in Quelltabelle  
QAbSpalte = 2                                                          'Nummer der 1. Datenspalte in Quelltabelle  
QBSpalte = "L"                                                        'Spalte für Betrag in Quelltabelle  

Spalten = 2                                                                'Spaltenanzahl für Vergleich  

ZTabelle = "Details"                                                       'Zieltabelle  
ZAbZeile = 1                                                               'Überschriftenzeile in Zieltabelle  
ZAbSpalte = 1                                                             'Nummer der 1. Datenspalte in Zieltabelle  
ZBSpalte = "D"                                                             'Spalte für Betag in Zieltabelle  

Delim = "§"                                                                   'Trennzeichen - darf in den Daten nicht vorkommen  

Set d = CreateObject("Scripting.Dictionary")                      'Dictionary zum Zwischenspeichern der (konsolidierten) Zeile erzeugen  
QZeile = QAbZeile                                                             'in Überschriftenzeile der Quelltabelle starten  
With Worksheets(QTabelle)
    Do Until .Cells(QZeile, QAbSpalte) = ""                            'Zeilen bearbeiten, bis in erster Spalte kein Wert mehr vorhanden  
        K = ""                                                                        'Schlüssel initialisieren  
        For i = 0 To Spalten - 1                                                 'alle Schlüsselspalten durchgehen  
            K = K & Delim & .Cells(QZeile, QAbSpalte + i)             'Schlüssel zusammensetzen  
        Next
        K = Mid(K, 2)                                                                'erstes Zeichen ist ein Trennzeichen - weglassen  
        Betrag = Val(.Cells(QZeile, QBSpalte))                           'Betrag auslesen  
        If d.Exists(K) Then                                                         'Wenn schon ein Eintrag für diesen Schlüssel vorhanden, ...  
            d.Item(K) = d.Item(K) + Betrag                                      '... Betrag addieren, ...  
        Else
            d.Add K, Betrag                                                            '... ansonsten Eintrag erstellen  
        End If
        QZeile = QZeile + 1                                                           'nächste Zeile der Quelltabelle  
    Loop
End With

T = d.Keys                                                                               'Schlüssel-Texte in Array übernehmen  
B = d.Items                                                                             'Beträge detto  
With Worksheets(ZTabelle)
    .Cells.ClearContents                                                             'Zieltabelle löschen  
    ZZeile = ZAbZeile                                                                   'in Überschriftenzeile der Zieltabelle beginnen  
    For i = 0 To UBound(T)                                                            'alle konsolidierten Einträge durchgehen  
                                                                                                 'Schlüssel-Text wieder in Spalten zerlegen und eintragen  
        .Cells(ZZeile, ZAbSpalte).Resize(1, Spalten) = Split(T(i), Delim)
        .Cells(ZZeile, ZBSpalte) = B(i)                                                 'Betrag(ssumme) eintragen  
        ZZeile = ZZeile + 1                                                                  'nächste Zeile der Zieltabelle  
    Next
End With
End Sub