Bağımsız Değer Listesi Oluşturma

[a long time ago]

Merhaba,

Elimde birbirinin tekrarı olabilecek isimlerin olduğu ve bu isimlerin karşılığı değerlerin mevcut bulunduğu bir liste var.

Amacım ise tekrarların olmadığı ve her ismin yer aldığı sadeleştirilmiş bir liste oluşturmak.

Ancak yerine getirmem gereken koşullardan biri, bu listedeki tekrarlı değerlerin yeni listede toplamını göstermek. (aa+aa+aa... gibi)

Ayrıca genel toplam içindeki payı %10'un altında kalanları da "Diğerleri" başlığında toplamak.

Son olarak listedeki isimler ve satır aralığı aydan aya değişmekte...

Ekteki dosyada kabaca bir örnek hazırladım. Makro yardımıyla nasıl çözüm bulabileceğim konusunda yardımınızı bekliyorum. Şimdiden teşekkürler.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

Sub Emre()
    Dim con As Object, rs As Object
    Dim sorgu As String, dosya As String
    Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordSet")
        Range("F3:G100").ClearContents
        dosya = ThisWorkbook.FullName
        con.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
        dosya & ";Extended Properties=""Excel 12.0;hdr=no"""
        sorgu = "Select distinct(F1), sum(F2) FROM [Sheet1$B3:C16] group by F1 "
        rs.Open sorgu, con, 1, 1
        Range("F3").CopyFromRecordset rs
        Range("F65536").End(3)(2, 1) = "GENEL TOPLAM"
        Range("G65536").End(3)(2, 1) = WorksheetFunction.Sum(Range("C3:C16"))
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
    dosya = vbNullString: sorgu = vbNullString
End Sub

 

[a long time ago]

Yardım için teşekkürler.

İlgili excel sayfasının kod kısmınıa yerleştirdim kodu ve çalıştırdım ama Run-Time '1004' hatası verdi...

 

[Murat OSMA]

Gereksiz alıntıyı silerseniz sevinirim...

Ek'teki dosyayı bir deneyiniz...

 

[a long time ago]

Şimdi çalıştı. Çok Teşekkürler.

Fakat dikkatimi çeken birkaç şey oldu. İlk olarak %10 koşulu geçerli değil sanırım. Ayrıca B sütununa yeni isimler eklediğimde ve makroyu çalıştırdığımda gördüğüm kadarıyla makro bu yeni isim ve değerleri işleme almıyor. Tekrar teşekkürler.

 

[Murat OSMA]

Rica ederim, iyi günler....