Soru Özel Toplama (Virgülle Ayrılmış Değerler)

[leonadies]

Üstadlar Şekildeki gibi R:S sütunda bazı verilerim var. Bu sütuna girilen ve aralarında virgül bulunan bu verileri bir buton yardımı ile;

hem benzersiz halde isimlerini hemde karşılarındaki sayı kadar toplamını Y:Z sütununda buldurabilir miyiz?

 

[Muzaffer Ali]

Merhaba.
KALEM,SİLGİ,DEFTER 9 yazıyor. Burada üçüne de adet olarak ayrı ayrı 9 mu eklenecek?

 

[leonadies]

Evet üstadım

 

[Muzaffer Ali]

Aşağıdaki kod ile yapabilirsiniz.

Sub Test()
    Dim Bak As Integer
    Dim Isim
    Dim Isimler As Integer
    Dim Say As Long
    Dim Bul As Range
    For Bak = 2 To Cells(Rows.Count, "R").End(xlUp).Row
        Isim = Split(Cells(Bak, "R").Text, ",")
        For Isimler = 0 To UBound(Isim)
            Set Bul = Range("Y:Y").Find(Isim(Isimler), LookIn:=xlFormulas, LookAt:=xlWhole)
            If Bul Is Nothing Then
                Say = Cells(Rows.Count, "Y").End(xlUp).Row + 1
                Cells(Say, "Y") = Isim(Isimler)
                Cells(Say, "Z") = Cells(Bak, "S")
            Else
                Cells(Bul.Row, "Z") = Cells(Bak, "S") + Cells(Bul.Row, "Z")
            End If
        Next
    Next
End Sub

 

[leonadies]

Ellerine sağlık sayın @dalgalikur Yine hızır gibi yetiştin imdadıma
Çok teşekkür ederim..

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.