Sistem Verisini Tabloya Dönüştürme / Ürün Reçetesi Formülleri

[walabi]

Merhaba,

Ekli dosyada sistemden aldığım verilerin olduğu bir sayfa ve bu verileri dönüştürmek istediğim bir excel sayfası mevcut.

Sistemden aldığım veriler, üretilen ürünün ( hazır beton ve türevleri ) reçetelerini oluşturan bir liste ve reçetelerin ( formüllerin ) sistemden excele aldığım orjinal hali ekteki gibi. Bu reçete verilerini veri tabanı mantığında tabloya dönüştürmek istiyorum. Bunun için uygun bir yöntem olabilir mi, ya da nasıl yapabilirim?

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Long
    Dim MalzemeAdedi As Integer
    Dim SonSatir As Long
    Dim Syf As Worksheet
    Set Syf = Worksheets("İstenen_Yapı")
   
    With Worksheets("Sistem_Verisi")
        For Bak = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(Bak, "A").Text = "Mal. Kodu" Then
               
                SonSatir = Syf.Cells(Rows.Count, "A").End(xlUp).Row + 1
                MalzemeAdedi = .Cells(Bak, "B").End(xlDown).Row
               
                Syf.Range("K" & SonSatir & ":O" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("A" & Bak + 1 & ":E" & MalzemeAdedi).Value

                Syf.Range("A" & SonSatir & ":A" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 5).Value
                Syf.Range("B" & SonSatir & ":B" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 4).Value
                Syf.Range("C" & SonSatir & ":C" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 3).Value
                Syf.Range("D" & SonSatir & ":D" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 2).Value
                Syf.Range("E" & SonSatir & ":E" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 1).Value
               
                Syf.Range("F" & SonSatir & ":F" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 5).Value
                Syf.Range("G" & SonSatir & ":G" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 4).Value
                Syf.Range("H" & SonSatir & ":H" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 3).Value
                Syf.Range("I" & SonSatir & ":I" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 2).Value
                Syf.Range("J" & SonSatir & ":J" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 1).Value
               
            End If
        Next
    End With
    MsgBox "Tamamlandı."
End Sub

 

[walabi]

Syn Muzaffer Ali, aşağıda resimde görünen satırlar verilerin eksik aktarılmasına sebep oluyor. Bu satırlar , pdf formatında olan verinin excele aktarılması sırasında oluşan gereksiz satırlar. Resimde görünen 54,55 ve 56 ıncı satırlar. Bu satırlar silince veriler eksiksiz olarak aktarılmış oluyor.



Teşekkürler,

 

[Muzaffer Ali]

Rapor Tarihi içeren tüm hücrelerin üst, alt ve kendi satırını silen bir kod ekledim.
Şimdi tekrar deneyin.

Sub Test()
    Dim Bak As Long
    Dim MalzemeAdedi As Integer
    Dim SonSatir As Long
    Dim Syf As Worksheet
    Set Syf = Worksheets("İstenen_Yapı")
   
    SayfaGecislerinisil
   
    With Worksheets("Sistem_Verisi")
        For Bak = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
            If .Cells(Bak, "A").Text = "Mal. Kodu" Then
               
                SonSatir = Syf.Cells(Rows.Count, "A").End(xlUp).Row + 1
                MalzemeAdedi = .Cells(Bak, "B").End(xlDown).Row
               
                Syf.Range("K" & SonSatir & ":O" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("A" & Bak + 1 & ":E" & MalzemeAdedi).Value

                Syf.Range("A" & SonSatir & ":A" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 5).Value
                Syf.Range("B" & SonSatir & ":B" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 4).Value
                Syf.Range("C" & SonSatir & ":C" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 3).Value
                Syf.Range("D" & SonSatir & ":D" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 2).Value
                Syf.Range("E" & SonSatir & ":E" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("B" & Bak - 1).Value
               
                Syf.Range("F" & SonSatir & ":F" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 5).Value
                Syf.Range("G" & SonSatir & ":G" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 4).Value
                Syf.Range("H" & SonSatir & ":H" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 3).Value
                Syf.Range("I" & SonSatir & ":I" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 2).Value
                Syf.Range("J" & SonSatir & ":J" & SonSatir + (MalzemeAdedi - Bak) - 1).Value = .Range("D" & Bak - 1).Value
               
            End If
        Next
    End With
    MsgBox "Tamamlandı."
End Sub

Sub SayfaGecislerinisil()
    Dim Bul As Range
    Do
        If Not Bul Is Nothing Then
            Rows(Bul.Row + 1).Delete
            Rows(Bul.Row - 1).Delete
            Rows(Bul.Row).Delete
        End If
        Set Bul = Cells.Find(what:="Rapor Tarihi", lookat:=xlPart)
    Loop While Not Bul Is Nothing
End Sub

 

[walabi]

Teşekkürler, Ellerinize sağlık.