Içeriği aynı satırların toplamını almak

[54526hande]

Ekte yer alan renk ve adetlerden oluşan bu tabloyu, bana her renkten kaç adet olduğunun yekününü gösterecek şekilde listelemek istiyorum. Boş satır ve renk adı tekrarı olmaksızın. Teşekkür ederim

 

[İhsan Tank]

Ekte yer alan renk ve adetlerden oluşan bu tabloyu, bana her renkten kaç adet olduğunun yekününü gösterecek şekilde listelemek istiyorum. Boş satır ve renk adı tekrarı olmaksızın. Teşekkür ederim

Merhaba
Eki İnceleyin
Sarı boyalı yerdeki formüller dizi formülüdür.

Dizi Formülü Formül Hücreye Girildikten Sonra Enter Tuşuna Basmadan Ctrl+Shift+Enter Tuş Kombinasyonu İle Aktif Olmaktadır. Formülün Başında Ve Sonunda { } Bu İşaretler Çıkar Elle Eklediğiniz Takdirde Formül Hata Verir.

Formüllerde 1000 satır baz alınmıştır.

1000 satır'ı değiştirmek için ctrl+h yapın aranan değere $1000 yeni değere $10000 yazın ve tümünü değiştir deyin.
$10000 olan yeri kendinize göre ayarlayınız.

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub renk_59()
Dim z As Object, a As Long, liste(), i As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("E:F").ClearContents
liste = Range("A1:B" & Cells(65536, "A").End(xlUp).Row).Value
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        z.Add liste(i, 1), liste(i, 2)
        Else
        z.Item(liste(i, 1)) = z.Item(liste(i, 1)) + liste(i, 2)
    End If
Next
Erase liste()
Range("E1").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Set z = Nothing
Application.ScreenUpdating = False
MsgBox "Yekunlar çıkarılmıştır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[54526hande]

teşekkürler

Çok teşekkürler, formülsuz sonuca ulaşmak namına, nice insanların gözleri şaşılaşmıştı

 

[54526hande]

İlgili koda şu işlevleri de eklememiz mümkün olursa çok müteşekkir olacağım.


-Her bir renk yekünü alınırken kaç adet toplam alındığı
-Renklerin toplam adetinin içinde her bir rengin yüzdesel olarak oranının gösterilmesi
- Yüzdesel olarak en yüksek oranlıdan düşük olana doğru sıralama

Teşekkürler,

 

[54526hande]

Ek İşlev

merhabal İhsan Hocam, formul gayet güzel çalışıyor sağolun. ancak benim için gerekli bir işlevi eklemeyi unutumuşum belirtmeyi. ekte belirttiğim gibi, her bir rengin tekrarlanma adedini de gösterecek şekilde düzenleyebilir misiniz formulu.
Şimdiden çok teşekküler,

Merhaba
Eki İnceleyin
Sarı boyalı yerdeki formüller dizi formülüdür. Formüllerde 1000 satır baz alınmıştır.

 

[İhsan Tank]

merhabal İhsan Hocam, formul gayet güzel çalışıyor sağolun. ancak benim için gerekli bir işlevi eklemeyi unutumuşum belirtmeyi. ekte belirttiğim gibi, her bir rengin tekrarlanma adedini de gösterecek şekilde düzenleyebilir misiniz formulu.
Şimdiden çok teşekküler,

Merhaba
I2 hücresine

=EĞER($G2="";"";EĞERSAY($A$2:$A$1000;$G2))

Bu formülü yazın ve aşağıya doğru çoğaltın.

 

[muzaffer.sm]

Bu kodların yazımı yararlı olmuş.Genişletilerek Heryerde kullanılabilir
Başka bir dosyada bu kodları bende kendime uyarladım. Filtreli toplamları kullanmaktansa bunu kullanmak daha süper

Teşekkür ederiz, Evren Bey.

 

[mbldn]

Evren Bey Merhaba;
size zahmet olmayacak ise aşağıdaki kod dizininde application.screenupdating=false
......
application.screenupdating= true
aralığını satır satır açıklayabilir misiniz?
türkçe karşılığı / açıklaması nedir
teşekkürler

Dosyanız ektedir.

Option Base 1
Sub renk_59()
Dim z As Object, a As Long, liste(), i As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("E:F").ClearContents
liste = Range("A1:B" & Cells(65536, "A").End(xlUp).Row).Value
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        z.Add liste(i, 1), liste(i, 2)
        Else
        z.Item(liste(i, 1)) = z.Item(liste(i, 1)) + liste(i, 2)
    End If
Next
Erase liste()
Range("E1").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Set z = Nothing
Application.ScreenUpdating = False
MsgBox "Yekunlar çıkarılmıştır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[Orion1]

Evren Bey Merhaba;
size zahmet olmayacak ise aşağıdaki kod dizininde application.screenupdating=false
......
application.screenupdating= true
aralığını satır satır açıklayabilir misiniz?
türkçe karşılığı / açıklaması nedir
teşekkürler

Bu kodlar arasındaki yapılan işler ekranda gözkmüyor.
Böylece kod daha hızlı çalışıyor.
Belki 10000 satır 2000 satır arasında veri varsa anlaşılmaz ama 30 bin 40 bin satır gibi veri varsa belkide yarıdan fazla zaman süresinde işlem biter.

 

[Orion1]

Bu kodların yazımı yararlı olmuş.Genişletilerek Heryerde kullanılabilir
Başka bir dosyada bu kodları bende kendime uyarladım. Filtreli toplamları kullanmaktansa bunu kullanmak daha süper

Teşekkür ederiz, Evren Bey.

Rica ederim.
Bir şey değil.
Tabiiki bir sorunun çözümünde 1 den fazla kodlama yapmak,çözüm elde etmek olabilir.Ama hiçlerinden en hızlısını seçmek lazım.Mesela ben öyle yapıyorum.
Bu yazdığım kod çok hızlı çalışır.Mesela 40000 50000 satır kadar çok satır varsa kodlamayı deneyin.