Makro zum Hinzufügen von Wert in Zellen der gleichen Kategorie

Question

Ich bin ziemlich neu in Makro-VBA. Es könnte sehr hilfreich sein, wenn jemand mich im Folgenden führen könnte.

Ich habe einen Datensatz, der Kategorie Name in Spalte A und in Spalte B die entsprechenden Werte hat. A3 gehört zur Kategorie „a“ Werte vorhanden, in B1: It looks somewhat like this

Basierend auf den Kategorienamen in Spalte A, I eine Summe von Werten, die in B., die A1 ist, wenn Zellen erhalten sollte sollten B3 summiert werden und die entsprechenden Zeilen in Spalt C und die resultierende Summe zusammengeführt werden soll auf folgende Weise in Spalte C angezeigt Output should look like this

ich versuchte

Sub main() 
Dim i As Long 
Dim a As Long ' 

Dim sum As Long 
sum = 0 
Dim samerows As Boolean 
samerows = True 
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row 

    If StrComp(Cells(i, 1), Cells(i + 1, 1), vbTextCompare) Then 
     samerows = False 
    End If 

    If samerows Then 
     sum = sum + Cells(i, 1).Value 
     Range(Cells(i, 2), Cells(i + 1, 2)).Merge 
    End If 

    samerows = True 
    Cells(i, 2).Value = sum 
Next i 

End Sub 

Aber dieser Code Code falsch, da ich nicht in der Lage bin um richtige Zellreferenzwerte bereitzustellen.

Es ist von großer Hilfe sein würde, wenn jemand ihre Gedanken teilen kann und leitet mich mit einem Code

Answer 1

Des Versuch, als Code wie möglich zu Ihrem Stil so nah zu halten, habe ich eine Zählung der Anzahl von Zellen Dies ist erforderlich, um sicherzustellen, dass Sie auf die Zelle oben links in einem Feld von verbundenen Zellen verweisen (da Excel die Werte speichert) und einige weitere Zusammenfassungsinstanzen hinzugefügt wurden. Bitte versuchen Sie folgendes:

Sub main() 
Dim i As Long 
Dim a As Long ' 

Dim sum As Long 
Dim mergeCnt As Long 
mergeCnt = 0 
sum = 0 
Dim samerows As Boolean 
samerows = True 
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row 

    If StrComp(Cells(i, 1), Cells(i + 1, 1), vbTextCompare) Then 
     sum = sum + Cells(i, 2).Value 
     samerows = False 
    End If 
    Debug.Print (sum) 
    If samerows Then 
     sum = sum + Cells(i, 2).Value 
     Range(Cells(i, 3), Cells(i + 1, 3)).Merge 
     mergeCnt = mergeCnt + 1 
    Else: 
     Cells(i - mergeCnt, 3).Value = sum 
     sum = 0 
     mergeCnt = 0 
    End If 

    samerows = True 
    Cells(i, 3).Value = sum 
Next i 

End Sub