Biçimsiz bir tabloyu makro ile düzenlemek.

[antitez21]

Merhaba,
Arkadaşlar muhasebe programından aldığım raporu düzenlemem gerekiyor. Rapor düzensiz bir şekilde olduğundan pivot tabloya yada veri alınabilecek bir tabloya dönüştüremiyorum Kısacası aşağıda vermiş olduğum örnek dosyanın birinci sayfasında bulunan tabloyu ikinci sayfasındaki gibi düzenlemek istiyorum. Makro ile bir kaç deneme yaptım ama başaramadım. Yardımcı olursanız çok memnun olurum.

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu "Sheet1" in kod sayfasına kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Long
    Dim IlkSatir As Integer
    Dim SonSatir As Integer
    Dim Syf2 As Worksheet
    Dim Son As Long
    Dim Satir As Integer
    
    Application.ScreenUpdating = False
    Set Syf2 = Worksheets("Sheet2")
    Syf2.Range("A1") = "a"
    Syf2.Cells.SpecialCells(xlCellTypeConstants, 23).Delete Shift:=xlToLeft
    
    For Bak = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(Bak, "A") = "" Then
            SonSatir = Bak
        Else
            If SonSatir > 0 Then
                If Cells(Bak, "A") = "Hesap" Then SonSatir = SonSatir - 1
                Son = Syf2.Cells(Rows.Count, "A").End(xlUp).Row
                If Son > 1 Then Son = Son + 1
                Satir = SonSatir - IlkSatir
                Syf2.Range("A" & Son & ":A" & Satir + Son - 1).Value = Cells(IlkSatir - 2, "B").Value
                Syf2.Range("B" & Son & ":B" & Satir + Son - 1).Value = Cells(IlkSatir - 2, "D").Value
                Syf2.Range("C" & Son & ":C" & Satir + Son - 1).Value = Cells(IlkSatir - 2, "A").Value
                Range("B" & IlkSatir & ":P" & SonSatir - 1).Copy Syf2.Cells(Son, "D")
                SonSatir = 0
            End If
            IlkSatir = Bak + 2
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Tamamlandı."
End Sub

 

[antitez21]

Hocam bilgin karşısında şaşkınım bu forum gerçekten excel konusunda son derece profesyonel bir ekibe sahip. Vallahi Tebrikler! Elle manuel yaparak saatlerimi alıyordu. Çok teşekkür ederim emeğine sağlık.