Yatay satırları dikeyde sıralama

[mersoy58]

Merhaba arkadaşlar

Elimizdeki yüzlerce yatay fatura satırını dikey olarak her bir satıra 3 kod gelecek şekilde sıralamak istiyoruz. Tam olarak anlatamadığım için ekteki tabloda örnek göstermeye çalıştım.

 

[Murat OSMA]

Şu kodları bir deneyiniz;

'*******************************************
'**                ¯/ /¯/ / ¯/              **
'** MuratOSMA ©  /¯  / / / ¯/  © Rky         **
'**              ¯   ¯    ¯                **
'*******************************************

Type Rky
     Kodlar As Variant
End Type

Sub Fatura()
    Dim Ürün As Rky
    Dim i As Integer, a As Integer, c As Integer
    Ürün.Kodlar = Array("120", "600", "391")
    Range("G2:J" & Range("G65536").End(3).Row).ClearContents
    For i = 2 To Range("A65536").End(3).Row
        For a = LBound(Ürün.Kodlar) To UBound(Ürün.Kodlar)
            Range("G65536").End(3)(2, 1) = Ürün.Kodlar(a)
            Range("H65536").End(3)(2, 1) = Cells(i, "A")
            For c = 2 To Range("G65536").End(3).Row
                If Cells(c, "G") = 120 And Cells(c, "H") = _
                    Cells(i, "A") Then Cells(c, "I") = Cells(i, "D")
                If Cells(c, "G") = 600 And Cells(c, "H") = _
                    Cells(i, "A") Then Cells(c, "J") = Cells(i, "B")
                If Cells(c, "G") = 391 And Cells(c, "H") = _
                Cells(i, "A") Then Cells(c, "J") = Cells(i, "C")
            Next c
        Next a
    Next i
    Rky = Empty: a = Empty: i = Empty: c = Empty: Kodlar = Empty
End Sub

 

[mersoy58]

Murat çok teşekkür ederim.

 

[Murat OSMA]

Rica ederim.

 

[mersoy58]

Merhaba Murat hocam

Örneği biraz değiştirmek istedim ama başarılı olamadım. Ekteki dosyaya göre rica etsem yeni kod verebilir misin ?

 

[Murat OSMA]

İstediğiniz tabloyu oluşturmak için kodları bu şekilde revize edebilirsiniz;

'*******************************************
'**                ¯/ /¯/ / ¯/              **
'** MuratOSMA ©  /¯  / / / ¯/  © Rky         **
'**              ¯   ¯    ¯                **
'*******************************************

Type Rky
     Kodlar As Variant
End Type

Sub Fatura()
    Dim Ürün As Rky
    Dim i As Integer, a As Integer, c As Integer
    Ürün.Kodlar = Array("120", "600", "391")
    Range("H2:M1000").ClearContents
    For i = 2 To Range("A65536").End(3).Row
        For a = LBound(Ürün.Kodlar) To UBound(Ürün.Kodlar)
            Range("H65536").End(3)(2, 1) = Cells(i, "A")
            Range("I65536").End(3)(2, 1) = Ürün.Kodlar(a)
            Range("J65536").End(3)(2, 1) = Cells(i, "B")
            Range("K65536").End(3)(2, 1) = Cells(i, "C")
            For c = 2 To Range("H65536").End(3).Row
                If Cells(c, "I") = 120 And Cells(c, "J") = _
                    Cells(i, "B") Then Cells(c, "L") = Cells(i, "F")
                If Cells(c, "I") = 600 And Cells(c, "J") = _
                    Cells(i, "B") Then Cells(c, "M") = Cells(i, "D")
                If Cells(c, "I") = 391 And Cells(c, "J") = _
                Cells(i, "B") Then Cells(c, "M") = Cells(i, "E")
            Next c
        Next a
    Next i
    Rky = Empty: a = Empty: i = Empty: c = Empty: Kodlar = Empty
End Sub

 

[mersoy58]

Murat teşekkür ederim. Çok makbule geçti sağol varol.

 

[Murat OSMA]

Sağlıcakla kalın !

 

[mersoy58]

Tekrar açmaya çalıştığımda
"makrosu çalıştırılamıyor. makro bu çalışma kitabında olmayabilir veya tüm makrolar devre dışı bırakılmış olabilir."

hatasını neden verir ?

 

[mersoy58]

Pardon arkadaşlar dosya türündenmiş sorunu çözdüm.