Çap ve Uzunlukları aynı olanları toplamak

[k0081]

Merhaba arkadaşlar;

çapı ve uzunlukları aynı olan satırları command buton kullanarak nasıl toplatabilirim ?

örnek dosya:

https://www.dosyaupload.com/95BN

 

[PLİNT]

Merhaba
Aşağıdaki gibi denermisiniz?

[SIZE="2"]Private Sub CommandButton1_Click()
i = Cells(Rows.Count, "B").End(3).Row
For a = 1 To i
If Cells(Rows.Count, "B").End(3).Row = a Then Exit For
s = 0
For b = Cells(Rows.Count, "B").End(3).Row To a + 1 Step -1
If Replace(Split(Cells(a, "B"), "ø")(1), " ", "") = Replace(Split(Cells(b, "B"), "ø")(1), " ", "") Then
s = s + Trim(Split(Cells(b, "B"), "ø")(0))
Cells(b, 1).EntireRow.Delete
End If
Next
s = s + Trim(Split(Cells(a, "B"), "ø")(0))
Cells(a, "B") = s & "ø" & Split(Cells(a, "B"), "ø")(1)
Next
End Sub[/SIZE]

 

[k0081]

Hocam çok teşekkür ediyorum. Tamamdır.. Elinize-Yüreğinize sağlık..