Excelldeki sütundaki veriye ve rengine göre sayma

[ftoy30]

Merhaba; ben excellde çok profosyonel değilim. Açılmış konulara baktım tam olarak aradığımı bulamadım.Bir excell tablosunda A sütununda örnek malzeme isimleri var. Benim istediğim A sütunundaki isimleri alsın C sütununa yazsın ama aynı isimde olanları bir defa yasın.D sütununda bu malzemelerin toplam sayısını alsın.(Örnek kalem başlığı altında toplam 5 kayıt var. C sütununa Kalemi 1 defa yazsın, ama D sütununda Kalem altında 5 kayıt olduğunu göstersin). E sütununa da A sütununda sarı ile boyalı olanların sayısını yazsın.( Kalem başlığında toplam 5 kayıt var ama bunlardan 2 tanesi sarı boyalı) Kalem örneğinden gidersek özetle, C sütununa Kalem, D sütuna 5, E sütununa 2 yazsın. Şimdiden yardımlarınız için teşekkür ederim. Örnek için Dosya eklemek istiyorum ama sanırım dosya eklemek için altın üyelik istiyor. Bu şekilde yardımcı olabilirseniz sevinirim.

 

[turist]

Sorunuzu kendi hazırladığınız bir "örnek" excel dosyası ekleyerek sorarsanız, daha hızlı ve doğru cevaplar bulabilirsiniz.
Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz:
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/

bakınız

 

[veyselemre]

Sub satirlardakiVerileriSutunlaraAktarSarıRenkSay()

    Set dic = CreateObject("Scripting.Dictionary")
    Range("C:E").ClearContents
    
    With dic
        For i = 2 To Cells(Rows.Count, 1).End(3).Row
            
            anahtar = Cells(i, 1).Value
            renk = False
            
            If Cells(i, 1).Interior.Color = vbYellow Then renk = True
            
            If Not .exists(anahtar) Then
                mx = mx + 1
                .Add anahtar, mx
                Cells(mx, "C") = anahtar
            End If
            
            sat = .Item(anahtar)
            Cells(sat, "D").Value = Cells(sat, "D").Value + 1
            
            If renk Then Cells(sat, "E").Value = Cells(sat, "E").Value + 1
        
        Next i

    End With

    Set dic = Nothing

End Sub

 

[ftoy30]

Sorunuzu kendi hazırladığınız bir "örnek" excel dosyası ekleyerek sorarsanız, daha hızlı ve doğru cevaplar bulabilirsiniz.
Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz:
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/

bakınız

Merhaba, teşekkür ederim. Örnek dosya linki aşağıdaki gibidir.

https://1drv.ms/f/s!AuVh_NsvA7IAgTAqTsIQ6gfa73JX

 

[veyselemre]

Örneğinize uyarlanmış hali,

Sub satirlardakiVerileriSutunlaraAktarSarıRenkSay()

    Set dic = CreateObject("Scripting.Dictionary")
    Range("D2:F" & Rows.Count).ClearContents
        mx = 2
    With dic
        For i = 3 To Cells(Rows.Count, 1).End(3).Row

            anahtar = Cells(i, 1).Value
            renk = False

            If Cells(i, 1).Interior.Color = vbYellow Then renk = True

            If Not .exists(anahtar) Then
                .Add anahtar, mx
                Cells(mx, "D") = anahtar
                mx = mx + 1
            End If

            sat = .Item(anahtar)
            Cells(sat, "E").Value = Cells(sat, "E").Value + 1

            If renk Then Cells(sat, "F").Value = Cells(sat, "f").Value + 1

        Next i

    End With

    Set dic = Nothing

End Sub

 

[ftoy30]

Örneğinize uyarlanmış hali,

Sub satirlardakiVerileriSutunlaraAktarSarıRenkSay()

    Set dic = CreateObject("Scripting.Dictionary")
    Range("D2:F" & Rows.Count).ClearContents
        mx = 2
    With dic
        For i = 3 To Cells(Rows.Count, 1).End(3).Row

            anahtar = Cells(i, 1).Value
            renk = False

            If Cells(i, 1).Interior.Color = vbYellow Then renk = True

            If Not .exists(anahtar) Then
                .Add anahtar, mx
                Cells(mx, "D") = anahtar
                mx = mx + 1
            End If

            sat = .Item(anahtar)
            Cells(sat, "E").Value = Cells(sat, "E").Value + 1

            If renk Then Cells(sat, "F").Value = Cells(sat, "f").Value + 1

        Next i

    End With

    Set dic = Nothing

End Sub

Çok teşekkür ederim. Çalıştı. Peki başka bir şey sormak istiyorum. Bu makroyu başka bir excelde verilerin farklı sütunlarda ya da satırlarda kullanmam gerekirse bu kod üzerinde nereleri değiştirmem gerekir. Bu konuda da bilgi verebilir misiniz?