Confronta i ranghi per vedere se sono uguali

Sto lavorando sul mio computer per automatizzare un preventsvo in Excel con VBA Consiste nel trovare duplicati in modo che possano essere riassunti.

Per esempio:

Ho le seguenti informazioni:

Clicca qui per il file Excel

La gamma da A2: C4 è un gruppo che si afferma che ci sono 28 bulloni, 1 dado per each bullone e 1 rondella per each bullone.

A5: C7 è un altro gruppo che è lo stesso 28 bulloni, 1 dado per each vite e rondella per each bullone.

A11: C13 è un altro gruppo ma la differenza è che per questo sono 2 dadi e 2 rondelle per bullone.

Quindi questo non sarà sum

Questo sarebbe il risultato:

Informazioni sull'uscita

Ho il codice riportto di seguito in cui esamina solo tutte le celle, non riesco a trovare un modo per farlo apparire in gruppi o intervalli.

Sub Macro1() Dim LastRow As Long, LastColumn As Long Dim wSrc As Worksheet: Set wSrc = Sheets("Hoja1") With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With wSrc LastRow = .Range("B" & .Rows.Count).End(xlUp).Row Set rng = .Range("B1:B" & LastRow) LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 2 rng.AdvancedFilter Action:=xlFilterCopy, copytoRange:=.Cells(1, LastColumn), unique:=True Z = .Cells(.Rows.Count, LastColumn).End(xlUp).Row LastColumn = LastColumn + 1 .Cells(1, LastColumn).Value = "Total" .Range(.Cells(2, LastColumn), .Cells(Z, LastColumn)).Formula = _ "=SUMIF(" & rng.Address & "," & .Cells(2, LastColumn - 1).Address(False, False) & "," & rng.Offset(, 1).Address & ")" End With With Application .ScreenUpdating = Truek .Calculation = xlCalculationAutomatic End With End Sub 

Fare clic su di seguito per il file di Excel