Karışık hücrelerdeki verileri aynı satırda sıralama

[lock&sawyer]

Sayın üstadlar,

Çalışmakta olduğum programdan excele veri cektiğimde çok karışık bir tablo sunuyor. benim isteğim her defasında belli bir düzene getirmek için uğraştığım raporu daha kolay bir şekilde yapmak. Bunun için siz değerli ustalardan yardım rica ediyorum. azda olsa makro bilgim var. ama bunu cozecek kadar değil. Ekteki örnek1 dosyası raporu programdan cektiğim ilk hali. örnek2 dosyası ise yapmak istediğim tablo. Yardımlarınıza şimdiden teşekkurler.

Örnek1 de renklendirdiğim verilerin örnek2 deki tablodaki renklerin altına sıralanmasını istiyorum

 

[Levent Menteşoğlu]

Bunu verileri çektiğiniz program üzerinden çözmelisiniz. Yada eğer kullandığınız program verileri bir txt dosyasına atabiliyorsa önce bu dosyayı oluşturun sonrada bu dosyadan excele verileri çekin. Böylece düzenlemeniz daha kolay olacaktır.

 

[Korhan Ayhan]

Merhaba,

Levent beyin dediklerine aynen katılıyorum. Fakat çoğu zaman paket program firmalarına bu raporları yaptırmak için eziyet çekiliyor. Ben bunu sık yaşadığım için biliyorum. Bu sebeple kullandığım bir çok raporu makrolar yardımıyla düzenlemek durumunda kalıyorum.

Örnek1 isimli dosyanızdaki düzensiz raporu Örnek2 isimli dosyanıza yeni bir sayfa ekleyerek kopyalayın. Eklediğiniz sayfanızın adı "Sayfa1" olsun.

Daha sonra aşağıdaki makroyu Örnek2 isimli dosyanıza uygulayıp çalıştırın.

Option Explicit
 
Sub RAPORU_DÜZENLE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Y As Integer, Satır As Long
    Dim Bul As Range, İlk As Long, Son As Long
    Dim Kod As String, Malzeme As String
 
    Application.ScreenUpdating = False
 
    Set S1 = Sheets("393.006")
    Set S2 = Sheets("Sayfa1")
 
    S1.Range("A3:F" & Rows.Count).Clear
    S1.Columns(1).NumberFormat = "dd.mm.yyyy"
    Satır = 3
 
    For X = 7 To S2.Cells(Rows.Count, 1).End(3).Row
        If S2.Cells(X, 1) = "Stok Kodu :" Then
            Kod = S2.Cells(X, 2)
            Malzeme = S2.Cells(X + 1, 2)
            İlk = X + 4
 
            Set Bul = S2.Range("A" & X + 1 & ":A" & Rows.Count).Find("Stok Kodu :", , , xlWhole)
            If Not Bul Is Nothing Then
                Son = Bul.Row - 1
            Else
                Son = S2.Cells(Rows.Count, 1).End(3).Row
            End If
 
            For Y = İlk To Son
                If IsDate(S2.Cells(Y, 1)) Then
                    S1.Cells(Satır, "A") = S2.Cells(Y, "A")
                    S1.Cells(Satır, "B") = Kod
                    S1.Cells(Satır, "C") = Malzeme
                    S1.Cells(Satır, "D") = S2.Cells(Y, "C")
                    S1.Cells(Satır, "E") = S2.Cells(Y, "I")
                    S1.Cells(Satır, "F") = S2.Cells(Y, "P")
                    Satır = Satır + 1
                End If
            Next
            X = Y - 1
        End If
    Next
 
    S1.Range("A2:F" & Satır - 1).Borders.LineStyle = 1
    S1.Range("D" & Satır + 1) = "TOPLAM"
    S1.Range("E" & Satır + 1) = WorksheetFunction.Sum(S1.Range("E3:E" & Satır - 1))
    S1.Range("F" & Satır + 1) = WorksheetFunction.Sum(S1.Range("F3:F" & Satır - 1))
    S1.Range("D" & Satır + 1 & ":F" & Satır + 1).Font.Bold = True
    S1.Range("D" & Satır + 1 & ":F" & Satır + 1).Borders.LineStyle = 9
    S1.Select
 
    Set Bul = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Ayrıca ekteki uygulamalı örnek dosyayıda inceleyebilirsiniz.

 

[lock&sawyer]

Korhan bey öok teşekkurler.Elinize sağlık.. beni nasıl bir yukten kurtardınız anlatamam