Gruplandırma

[waytooraider]

Elimede 12 bin satırlı dosya var. A stununda kırmız renkli olanlar gruplansın diye birşey yapabilirmiyiz.

Saygılarımla.

 

[uzmanamele]

Elimede 12 bin satırlı dosya var. A stununda kırmız renkli olanlar gruplansın diye birşey yapabilirmiyiz.

Saygılarımla.

Merhaba
Gruplandırma tek bir aralıktaysa evet, aralıklı ise hayır.
Örnek dosyanızı elerseniz, alternatif çözümler olabilir.

 

[waytooraider]

Dosyayı Ektedir.

Saygılarımla.

 

[waytooraider]

Galiba Böyle Bir Gruplandırma Olmuyor.

 

[uzmanamele]

Merhaba

İstediğiniz mümkün, telaşlanmayın.
2 yöntem izlenebilir.
Eğer listeniz renklendirilmiş ise bu renge göre gruplandıralım.
Eğer henüz renklendirilmemişse (12.000 satır diyorsunuz, boşuna uğraşmayın) kodlamaya göre gruplandırılır.

 

[uzmanamele]

Merhaba

Ek dosyadaki gibi mi?

Sub Gruplandir()
On Error Resume Next
Cells.Rows.Ungroup
    ss = [b65536].End(3).Row
    For x = 3 To ss
        If Cells(x, 2).IndentLevel > 0 Then Cells(x, 2).InsertIndent -1 * Cells(x, 2).IndentLevel
        If Cells(x, 2) Like "??.??.??.??" Then
            Cells(x, 7) = 1
        ElseIf Cells(x, 2) Like "??.??.??.???" Then
            Cells(x, 7) = 2
        Else
            Cells(x, 7) = 3
        End If
        If Cells(x, 7) > 0 Then Cells(x, 2).InsertIndent Cells(x, 7)
    Next x
Rem ??.??.??.?? şeklinde olanları gruplandır
    For x = 3 To ss
        If Cells(x, 7) = 1 Then
            For y = x To ss
                If Cells(y, 7) <> 1 Then
                    Exit For
                End If
            Next y
            bas = x: son = y - 1:

                Range(Cells(bas, 7), Cells(son, 7)).Rows.Group
                
            x = y
        End If
    Next x
    
Rem ??.??.??.??? şeklinde olanları gruplandır
    For x = 3 To ss
        If Cells(x, 7) = 2 Then
            For y = x To ss
                If Cells(y, 7) <> 2 Then
                    Exit For
                End If
            Next y
            bas = x: son = y - 1:

                Range(Cells(bas, 7), Cells(son, 7)).Rows.Group
                
            x = y
        End If
    Next x
        Columns("G:G").ClearContents

    MsgBox "Bittim..."
End Sub

 

[waytooraider]

Eline sağlık bir önceki grubu silmemesini sağlayabilirmiyiz.

 

[uzmanamele]

Eline sağlık bir önceki grubu silmemesini sağlayabilirmiyiz.

Merhaba
Aşağıdaki satırları silerseniz önceki gruplandırma kalır.

On Error Resume Next
Cells.Rows.Ungroup

Burada ince bir nokta var, silip silmeme kararını buna göre verin.
Gruplandırmayı yaptıktan sonra 01.01.01.08'nin altına sonradan 01.01.01.09 eklerseniz iç içe grup olacaktır.
Bu nedenle kod çalışmadan sayfada gruplandırma varsa kaldırır.

 

[waytooraider]

Satırları silince olmadı ama bu haliylede cok işime yaradı.Ekteki dosyada Cemil'in altında kalanları grup kısmında nasıl + gösterebilirim.

Saygılarımla

 

[JUJUVA]

merhaba. yeni konu açmak için nereye girmeliyim

 

[waytooraider]

Ekteki dosyayı kodunuza göre çalıştıramadım.Acaba bu konuda yardımcı olabilirmisiniz.Yardımcı olabilen varmı acaba.

 

[waytooraider]

Eklediğim dosyaya uzmanamele ustadimizin kodunu uygulayamadim çalışmadı. Bu konuda yardımcı olursanız olabilirseniz çok sevinirim

Saygılarımla.

 

[uzmanamele]

Merhaba

Aşağıdaki satırı değiştirerek deneyiniz.

        ElseIf Cells(x, 2) Like "??.??.??.???[COLOR="Red"]?[/COLOR]" Then

 

[waytooraider]

Çok Teşeküür Ederim Kahramanım.