vba da dizi fonksiyonu ile benzersiz liste ve toplam alma

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu şekilde deneyiniz.

Küsüratlı sayılarda yuvarlama yapmak sorunu çözebilir.

C++:
Option Explicit

Sub ToplamAl()
    Dim Veri As Variant, X As Long, Say As Long, Son As Long

    Son = Sheets("sayfa1").Cells(Rows.Count, 1).End(3).Row
    If Son < 3 Then Son = 3
    
    Veri = Range("A2:B" & Son).Value2
    
    ListBox1.Clear
    
    ReDim Liste(1 To 2, 1 To 1)
    
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Not .Exists(Veri(X, 1)) Then
                Say = Say + 1
                .Add Veri(X, 1), Say
                ReDim Preserve Liste(1 To 2, 1 To Say)
                Liste(1, Say) = Veri(X, 1)
                Liste(2, Say) = VBA.Format(VBA.Round(Veri(X, 2), 2), "#,##0.00")
            Else
                Liste(2, .Item(Veri(X, 1))) = VBA.Format(VBA.Round(Liste(2, .Item(Veri(X, 1))) + Veri(X, 2), 2), "#,##0.00")
            End If
        Next
    End With
    
    ListBox1.ColumnCount = 2
    ListBox1.Column = Liste
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu da #5 nolu mesajınızda ki sorunuzun cevabıdır.

C++:
Option Explicit

Sub Summary()
    Dim My_Data As Variant, Last_Row As Long, X As Long
    Dim Record_Count As Long, Process_Time As Double
    
    Process_Time = Timer
    
    Range("C2:C" & Rows.Count).ClearContents
    
    Last_Row = Cells(Rows.Count, 1).End(3).Row
    If Last_Row < 3 Then Last_Row = 3
    
    My_Data = Range("A2:B" & Last_Row).Value2
    
    ReDim Sum_List(1 To Rows.Count, 1 To 1)
    
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(My_Data, 1) To UBound(My_Data, 1)
            If Not .Exists(My_Data(X, 1)) Then
                Record_Count = Record_Count + 1
                .Add My_Data(X, 1), Record_Count
                Sum_List(Record_Count, 1) = My_Data(X, 2)
            Else
                Sum_List(.Item(My_Data(X, 1)), 1) = Sum_List(.Item(My_Data(X, 1)), 1) + My_Data(X, 2)
            End If
        Next
        
        ReDim My_List(1 To Rows.Count, 1 To 1)
        
        For X = LBound(My_Data, 1) To UBound(My_Data, 1)
            My_List(X, 1) = Sum_List(.Item(My_Data(X, 1)), 1)
        Next
        
        Range("C2").Resize(UBound(My_Data, 1)) = My_List
    End With
    
    Erase My_Data
    Erase Sum_List
    Erase My_List
    
    MsgBox "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
End Sub
 

şehiriçi

Altın Üye
Katılım
1 Ağustos 2013
Mesajlar
562
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Korhan moderatörüm ,Emeğinize sağlık , çok teşekkürler
listbox düzeldi istediğim gibi oldu .5 nolu mesaj daki sorumun cevabı alındı ve kod çok hızlı çalıştı .
Ancak sorumun cevabını vermiş olmanıza rağmen (kayan noktalı...) bir nevi tekrar gibi olacak ama 18 nolu mesajımdaki bu şu kısmı tekrar kopyalayıp gönderiyorum

sarı renkle işaretlediğim hücreler örneğin C3 seçildiğinde formül çubuğuna baktığınızda 1,81898940354586E-12 rakamı görünüyor . ama C3 hücresine bakınca 0,000 görünüyor . Ama gerçekte örneğin mustafa ların C sütunundaki verilerini toplayınca 0,000 olması doğru sonuç niye formül çubuğunda rakam geliyor sonucu ilerde yanlış yapmaz mı
formül çubuğunda da 0,000 görünme ihtimali yokmu , ya da sakıncası yoksa teşekkür edip bu konuyu kapatacağım , teşekkürler
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Excel ondalıklı sayırlarda bu sapmayı bünyesinde barındırıyor. Bu sebeple YUVARLAMA fonksiyonlarının kullanılmasını tavsiye ediyorlar.

Sizin sorun oluşturur dediğiniz küsürattaki rakamlar ekteki dosyada göreceğiniz üzere 12. karakterde başlıyor. Bu sebeple çok büyük sıkıntılara yol açacağını düşünmüyorum.

Ek olarak önerdiğim makroya ROUND (YUVARLA) özelliğini ekledim. Butona tekrar tıkladığınızda o gördüğünüz küsüratların yok olduğunu görebilirsiniz.

Yine konuyla ilişkili olduğunu düşündüğüm linki inceleyiniz.

 

Ekli dosyalar

şehiriçi

Altın Üye
Katılım
1 Ağustos 2013
Mesajlar
562
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Korhan bey sorunum da bitmiyor ki , mümkünse bir ricam daha olacak ,
listboxta 2 sütunda ki veri eğer sıfır ise (0,000) görünmesin bana sadece sıfırdan farklı olanlar lazım .sıfır olanlar alacak_borcu olmayanlar oysa bana sadece alacak borç kısmı lazım .yani sıfırdan farklı olanlar
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Profilinizde yazan excel sürüm bilgisi yeterli değildir. Güncellemenizi rica ederim. Bizim profilimizde yazanları örnek alabilirsiniz.

Excel Vers. ve Dili 2003
 

şehiriçi

Altın Üye
Katılım
1 Ağustos 2013
Mesajlar
562
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Korhan bey excel vers 2016 kullandığım bilgisayarda ayrıca güncellemeyi nasıl yapıyoruz
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
#24 nolu mesajımda ki dosyayı son talebinize göre revize ettim. İndirip deneyebilirsiniz.
 

şehiriçi

Altın Üye
Katılım
1 Ağustos 2013
Mesajlar
562
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Korhan bey , excel sürüm bilgimi güncelledim kod larda istediğim gibi oldu ,teşekkürler, iyi ki varsınız sağlıkla kalın ..
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sürüm bilgisi eksik olmuş. Bizlerin profiline bakarak güncellerseniz daha faydalı olacaktır. Bu bilgiler size verilen cevaplar için önem arz etmektedir.

Ofisin Yıl Bilgisi
Ofisin Dil Bilgisi
Ofisin Bit Bilgisi

Mesela ben sizin gibi profil bilgisi olan bir üyeye İNGİLİZCE formül önerir geçerim.
 

şehiriçi

Altın Üye
Katılım
1 Ağustos 2013
Mesajlar
562
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
VBA.CreateObject("Scripting.Dictionary") bu nesneyi anlayacağımız şekilde anlatan bir youtube kanalı veya site varmı? anlamakta çok zorlanıyorum dahası anlıyamıyorum ,okumak değilde birisi anlatınca kavrayacağımı umuyorum , Teşekkürler
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bence en önce temel vba bilgilerini öğrenmenizde fayda var. Sonrası zaten ihtiyaca göre şekillenecektir.
 

şehiriçi

Altın Üye
Katılım
1 Ağustos 2013
Mesajlar
562
Excel Vers. ve Dili
Ofis 2016 TR 32 Bit
Ömer hocam bende ingilizce yok ..türkçe kaynak yok mu?
Korhan hocam temel vba bilgileri derken az açıklık getirsen....
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Siz önce #30 nolu mesajıma uygun şekilde ofis sürümünü güncelleyiniz.

Örnek;
230921
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,325
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ömer hocam bende ingilizce yok ..türkçe kaynak yok mu?
Korhan hocam temel vba bilgileri derken az açıklık getirsen....
Dictionary nesnesine gelmeden önce bence öğrenmeniz gereken daha başka konuların olduğunu düşünüyorum.

Aşağıdaki konular hakkında temel bilginiz var mı?

VBA- Sayfa Olayları
VBA- Çalışma Kitabı Olayları
VBA- Modüle Ekleme - Makro Oluşturma - Makro Kaydet Yöntemi
VBA- Döngüler (For-Next / Do-While-Loop / While-Wend)
VBA- If-End If Sorgu Teknikleri
VBA- Select Case-End Select Sorgu Teknikleri

Bu temel teknikleri öğrenmeden üst seviye diyebileceğimiz Dictionary nesnesini öğrenmeye çalışmak çok akıllıca olmayacaktır.
 
Üst