Hem yatay hem de dikey sıralama

[nnermin06]

Arkadaşlar merhaba.
Ekteki dosyada görüleceği üzere; Sayfa1 deki verileri,Sayfa2'ye bölümlere ayırarak hem yatay hem de dikey olarak alfabetik sıra ile sıralatmak istiyorum.
Şimdiden teşekkürler

 

[Necdet]

Merhaba,

Dosyanızı inceledim, istediğinizi bir ölçüde anladım ama soru işaretleri var.

1. Sayfa1 de tüm veriler girildikten sonra mı dağıtım olacak, yoksa her girişte mi girilen değerin dağıtımı gerçekleştirilecek?
2. Satırda sıralamak kolay ama Sütunda sıralamanın ölçütü nedir?

İlk harfe mi bakılacak, ilk 2 karaktere mi, ilk 3 karaktere mi?
Dosyanızda C120201 var, C200000 değeri olduğunda aynı sütunda mı olacaklar başka sütunda mı?

Gördüğünüz gibi sorun çok, açıklamalarınız yetersiz.

Daha fazla bilgi verirseniz çözüme daha kolay ulaşılılır.

 

[muygun]

Merhaba;
Verilerinizin sonundaki sayısal karakter sayısı standart (6) ise eki inceleyin.
İyi çalışmalar.

 

[nnermin06]

Öncelikle 2 üstadıma da çok teşekkür ederim. Muygun arkadaşımızın çözümü tam aradığım çözüm. Ama emeğe saygı açısından Necdet Hocamın da sorularını yanıtlamak istiyorum :
1) Sayfa1'de her veri girişinden sonra dağıtım yapılacak.
2) Sadece baştaki alfabetik değerler önemli. Diğer 6 basamaklı sayının açılımı şöyle : Örneğin; B120201 verisini ele alalım. "B" Boru bölümü, "12" 2012 yılının son iki rakamı, "02" Şubat ayı (Mart ayında bu 03 olacak) sondaki 01 rakamı da Boru bölümünden verilen sıra sayısı. Sizin anlayacağınız hocam C200000 olmaz. En fazla C121299 olur.
İlginize,bilginize ve emeğinize sonsuz teşekkürler.

 

[Necdet]

Merhaba,

Yeni açıklama üzerine makrolu çözümü de ben önereyim.

Şimdilik mevcut yazılanları sıralar, eğer bu sıralama doğru ise, kodları veri giriş sırasında işlem gören duruma çevirmek olası.

Option Compare Text
Sub Sayfada_Duzenle_Sirala()
    Dim i   As Long, _
        j   As Long, _
        k   As Integer, _
        Uz  As Integer, _
        Abc As String, _
        s1  As Worksheet, _
        s2  As Worksheet
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
        
    For i = 1 To s1.Cells(Rows.Count, "B").End(3).Row
        Uz = Len(s1.Cells(i, "B")) - 6
        Abc = Left(s1.Cells(i, "B"), Uz)
        For k = 1 To s2.Cells(2, 1).End(2).Column + 1
            If s2.Cells(2, k) = "" Then Exit For
            If Left(s2.Cells(2, k), Uz) = Abc Then Exit For
            If Abc < Left(s2.Cells(2, k), Uz) Then
                s2.Columns(k).Insert
                Exit For
            End If
        Next k
        j = s2.Cells(Rows.Count, k).End(3).Row + 1
        s2.Cells(j, k) = s1.Cells(i, "B")
    Next i
    
    s2.Cells.EntireColumn.AutoFit
End Sub

 

[nnermin06]

Necdet hocam merhaba.
İlgine ve emeğine teşekkürler. Sizin yaptığınız da harika olmuş. Ufak bir aksaklık var. Şöyle ki:
AC120204 yazıp listeledikten sonra AC120203 yazdık mı bunu sıralamaya sokup AC120204'ün üstüne almıyor. Ayrıca butonla değil de yazıldığı anda listeleme şeklinde yaparsanız çok daha iyi olur. Şimdiden teşekkürler

 

[Necdet]

Necdet hocam merhaba.
İlgine ve emeğine teşekkürler. Sizin yaptığınız da harika olmuş. Ufak bir aksaklık var. Şöyle ki:
AC120204 yazıp listeledikten sonra AC120203 yazdık mı bunu sıralamaya sokup AC120204'ün üstüne almıyor. Ayrıca butonla değil de yazıldığı anda listeleme şeklinde yaparsanız çok daha iyi olur. Şimdiden teşekkürler

Merhaba,

Verdiğim kodlar örnek kodlardı, zaman bulduğumda veri girişte dağıtım işini yapar hale getireceğim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları Sayfa1'in kod bölümüne kopyalayıp deneyiniz. Veri giriş yapıldıkça Sayfa2 de dağıtım gerçekleşecektir.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim i   As Long, _
        j   As Long, _
        k   As Integer, _
        Uz  As Integer, _
        Abc As String, _
        s1  As Worksheet, _
        s2  As Worksheet
    
    If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
    
    If Len(Target.Value) < 7 Then
        Target.Offset(0, 0).Select
        Exit Sub
    End If
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
        
    Uz = Len(Target.Value) - 6
    Abc = Left(Target.Value, Uz)
    
    For k = 1 To s2.Cells(2, 1).End(2).Column + 1
        If s2.Cells(2, k) = "" Then Exit For
        If Left(s2.Cells(2, k), Uz) = Abc Then Exit For
        If Abc < Left(s2.Cells(2, k), Uz) Then
            s2.Columns(k).Insert
            Exit For
        End If
    Next k
    
    j = s2.Cells(Rows.Count, k).End(3).Row + 1
    s2.Cells(j, k) = Target.Value
    s2.Range(s2.Cells(2, k), s2.Cells(j, k)).Sort Key1:=s2.Cells(1, k)
    
    s2.Cells.EntireColumn.AutoFit
 
End Sub

 

[nnermin06]

Sayın hocalarım. İlginize ve emeğinize teşekkür ediyorum. İkisi de harika oldu. Tam istediğim gibi.Tekrar teşekkürler

 

[Necdet]

Sayın hocalarım. İlginize ve emeğinize teşekkür ediyorum. İkisi de harika oldu. Tam istediğim gibi.Tekrar teşekkürler

Güle güle kullanınız.