Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Scripting.Dictionary nesnesi hakkında (http://www.excel.web.tr/showthread.php?t=146392)

kuvari 02-02-2015 12:50

Scripting.Dictionary nesnesi hakkında
 
1 Eklenti(ler)
Merhaba,

Scripting.Dictionary nesnesini öğrenmek için bir örnek çalışma yaptım, tek sütunda işlem yapmak istediğimde yapabildim ama işin içine 2 sütun girince yöntemini bulamadım. Yapmak istediğim sayfa1'de benzersiz olanları sayfa2'de listelemek.

İlave bir sorum daha olacak , Scripting.Dictionary 'de oluşan dizinin tek haneli olarak nasıl alabilirim.

s.Keys bütün verileri kapsıyor, sadece dizideki sıra numarası yazarak nasıl getirebilirim.

Korhan Ayhan 02-02-2015 13:34

İkinci sütundaki sayılar toplanacak mı? Yani bir nevi ÖZET TABLO gibi mi işlem yapılacak?

Yoksa iki sütuna göre benzersiz kayıtlarımı listelemek istiyor sunuz?

kuvari 02-02-2015 13:42

Alıntı:

Korhan Ayhan tarafından gönderildi (Mesaj 795271)
İkinci sütundaki sayılar toplanacak mı? Yani bir nevi ÖZET TABLO gibi mi işlem yapılacak?

Yoksa iki sütuna göre benzersiz kayıtlarımı listelemek istiyor sunuz?

Korhan üstad benzersiz kayıtları listelemek istiyorum.

Başka bir sayfada toplam olarakta aldırabilirsiniz. İkisinide görmüş olurum.

Korhan Ayhan 02-02-2015 13:47

Aşağıdaki kod çift sütuna göre benzersiz verileri listeler.

Kod:

Sub BENZERSİZ_ÇİFT_SÜTUN()
    Dim s As Object, liste(), dizi()
   
    Son = Sheets(1).Cells(Rows.Count, "a").End(3).Row
    liste = Sheets(1).Range("a2:b" & Son).Value
   
    ReDim dizi(1 To Son, 1 To 2)
   
    Set s = CreateObject("Scripting.Dictionary")
   
    For i = 1 To UBound(liste, 1)
        Aranan = liste(i, 1) & liste(i, 2)
        If Not s.exists(Aranan) Then
            s.Add Aranan, Nothing
            Say = Say + 1
            ReDim Preserve dizi(1 To Son, 1 To 2)
            dizi(Say, 1) = liste(i, 1)
            dizi(Say, 2) = liste(i, 2)
        End If
    Next i
   
    Sheets(2).Range("A2").Resize(s.Count, 2) = dizi
End Sub


Korhan Ayhan 02-02-2015 13:57

Aşağıdaki kod ise tek sütundaki benzersizleri listelerken ikinci sütundaki verileri toplayarak rapor oluşturur. Yani bir nevi özet tablo gibi çalışır.

Kod:

Sub BENZERSİZ_TEK_SÜTUN_TOPLAMALI()
    Dim s As Object, liste(), dizi()
   
    Son = Sheets(1).Cells(Rows.Count, "a").End(3).Row
    liste = Sheets(1).Range("a2:b" & Son).Value
   
    ReDim dizi(1 To Son, 1 To 1)
   
    Set s = CreateObject("Scripting.Dictionary")
   
    For i = 1 To UBound(liste, 1)
        Aranan = liste(i, 1)
        If Not s.exists(Aranan) Then
            Say = Say + 1
            s.Add Aranan, Say
            ReDim Preserve dizi(1 To Son, 1 To 2)
            dizi(Say, 1) = liste(i, 1)
        End If
        dizi(s.Item(Aranan), 2) = dizi(s.Item(Aranan), 2) + liste(i, 2)
    Next i
   
    Sheets(2).Range("A2").Resize(s.Count, 2) = dizi
End Sub


kuvari 02-02-2015 14:17

Hocam ellerinize sağlık, çok güzel başvuru kaynağı oldu benim için.

Hocam bir sorum daha vardı,Scripting.Dictionary dizinindeki sıra numarasına göre nasıl gösterebilirim, dizi (1) dediğimde dizinin birinci değerini getirmek gibi.

kuvari 02-02-2015 14:48

Korhan hocam bir sorum daha olacak. Sadece "a" ları listelemek isteseydim, nasıl kodlamak gerekirdi.

Korhan Ayhan 02-02-2015 16:02

Şimdilik aşağıdaki linki inceleyiniz. Bol bol örnek var.

http://www.snb-vba.eu/VBA_Dictionary_en.html

kuvari 02-02-2015 16:33

Korhan bey kaynak için sağolun,yine de sizden cevap bekliyorum.

kuvari 02-02-2015 17:01

Korhan bey sadece a'ları getirebildim ama Scripting.Dictionary nesnesine hiç ihtiyacım olmadı.

Aklıma takılan Scripting.Dictionary dizinindeki sıra numarasına göre nasıl gösterebilirim, dizi (1) dediğimde dizinin birinci değerini getirmek gibi

Kod:

Option Base 1
Sub BENZERSİZ_ÇİFT_SÜTUN()
On Error Resume Next
    Dim s As Object, liste(), dizi()
   
    Son = Sheets(1).Cells(Rows.Count, "a").End(3).Row
    liste = Sheets(1).Range("a2:b" & Son).Value
   
    ReDim dizi(1 To Son, 1 To 2)
   
    Set s = CreateObject("Scripting.Dictionary")
   
    For i = 1 To UBound(liste, 1)
        aranan = liste(i, 1)
      If aranan = "a" Then
    '    If Not s.exists(aranan) Then
            s.Add aranan, Nothing
            Say = Say + 1
            ReDim Preserve dizi(1 To Son, 1 To 2)
            dizi(Say, 1) = liste(i, 1)
            dizi(Say, 2) = liste(i, 2)
        'End If
        End If
    Next i
   
    Sheets(2).Range("A2").Resize(UBound(dizi), 2) = (dizi)
End Sub



Saat 21:18

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.