Gruplandırma

[Milady Meriç]

Herkese selamlar, saygılar.

Bir veri yığının nasıl gruplandırılabileceği hakkında bir sorum olacak. Aslında SQL'deki group by fonksiyonuna benziyor.

Ekteki dosyada sorunumu ayrıntısı ile dile getirmeye çalıştım.


Saygılar.

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz.

Not : Listenin SIRALI olduğu varsayılmıştır.

Sub Grup()
    
    Dim i   As Long, _
        j   As Long, _
        Kol As Integer, _
        Deg As String
    
    Application.ScreenUpdating = False
    Sheets(1).Select
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        If Not Deg = Cells(i, "A") & Cells(i, "B") Then
            Deg = Cells(i, "A") & Cells(i, "B")
            Kol = Kol + 1
            Sheets(2).Cells(1, Kol) = Deg
            j = 1
        End If
        
        j = j + 1
        Sheets(2).Cells(j, Kol) = Cells(i, "C")
        
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "Listeleme Bitmiştir....", vbInformation, "Necdet YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

 

[Milady Meriç]

Necdet Bey diğer üstadlar;
Elinize sağlık, çok teşekkür ederim, rica ettiğim işlemi çok güzel kodlamışsınız.

Kusura bakmayın ama ilk mesajımda belirtmeyi unuttuğum bir iki nokta. Ekte ayrıntısı ile anlattım. İlgilenirseniz çok mutlu olurum.

Saygılar.

 

[Milady Meriç]

Necdet Bey diğer üstadlar;
Elinize sağlık, çok teşekkür ederim, rica ettiğim işlemi çok güzel kodlamışsınız.

Kusura bakmayın ama ilk mesajımda belirtmeyi unuttuğum bir iki nokta. Ekte ayrıntısı ile anlattım. İlgilenirseniz çok mutlu olurum.

Saygılar.

herkese tekrar selam;

İstediğim teknik açıdan mümkün değil mi? eN AZINDAN MÜMKÜN OLMADIĞINI bilirsem, yoluma başka türlü devam etmem gerekecek.
Bu konuda bilgi verirseniz çok sevinirim.

Saygılarımla

 

[Asri]

Necdet bey in kodlarına bir ekleme yaptım. Kontrol ediniz.

 

[Milady Meriç]

Sayın Asri;

Ellerinize sağlık.

Saygılarımı sunuyorum.

 

[Necdet]

Merhaba,

Biraz gecikmeli oldu ama idare ediniz.
Kodlarda yapılan değişiklikleri kırmızı ile işaretledim.

Sub Grup()
    
    Dim i   As Long, _
        j   As Long, _
        Kol As Integer, _
        Deg As String
    
    Application.ScreenUpdating = False
    [B][COLOR=red]Sheets(2).Cells.ClearContents
[/COLOR][/B]    Sheets(1).Select
    
[B][COLOR=red]    'Var Olan Ad Tanımları AU İle Başlıyorsa Silinir
    For i = ActiveWorkbook.Names.Count To 1 Step -1
        If ActiveWorkbook.Names(i).Name Like "AU*" Then ActiveWorkbook.Names(i).Delete
    Next i
[/COLOR][/B]    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row + 1
        If Not Deg = Cells(i, "A") & Cells(i, "B") Then
[COLOR=red][B]            If Not Deg = "" Then
                ActiveWorkbook.Names.Add _
                Name:=Deg, _
                RefersTo:="=" & Sheets(2).Name & "!" & Range(Cells(2, Kol), Cells(j, Kol)).Address
            End If
[/B][/COLOR]        
            Deg = Cells(i, "A") & Cells(i, "B")
            Kol = Kol + 1
            Sheets(2).Cells(1, Kol) = Deg
            Sheets(2).Cells(2, Kol) = "ALL"
            j = 2
        End If
        j = j + 1
        Sheets(2).Cells(j, Kol) = Cells(i, "C")
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "Listeleme Bitmiştir....", vbInformation, "Necdet YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

 

[bu benim]

Herkese Merhabalar,

Benim de benzer bir veri gruplandırmalı listem var, İndis vb. fonksiyonlar ile gruplandırma yapmayı başardım ancak 3.sayfada Makro ile yapmak istiyorum, Necdet Bey'in kodlarından ilham alarak birşeyler denedim maalesef yapamadım. Sürekli sağa doğru uzayan bir liste oldu, bu konuda bilgi verirseniz sevinirim.


Saygılarımla,