bu işlem için makro ya da formül yazılabilir mi?

[ozgurcan79]

Yeni başladığım işimde ERP sistemi ile çalışılıyor. Bir firma ile anlaşılmış ve projnin metrajları istenmiş. Gelen metrajlar ise ERP sistemine girmek için yapı olarak yetersiz. Kısaca veriler yatayda. Halbuki ERP sistemi için verilerin düşeyde olması gerekiyor.

Ekteki örnek tablodan istenilen veriyi elde etmem için hangi formülü ya da makroyu kullanmam gerekli. Yardımlaınızı bekliyorum arkadaslar.

 

[asi_kral]

Merhaba
Konu başlığınız konunun içeriğini anlatır şekilde olmalı
Ayrıca mesela A blokta veri yoksa ne olacak ( diğerleri de olabilir )

 

[Necdet]

Merhaba,

Blok sayısı artarsa diye parametrik yapmaya çalıştım. Kodların uzaması o nedenle oldu.

Verilerin bulunduğu sayfa adının "Veri", düzenlenmiş verilerin yazdırıldığı sayfa adının da "Duzenlenmis" olduğu varsayılmıştır.

Aşağıdaki kodları deneyiniz.

Sub Duzenle()
    
    Dim i       As Long, _
        j       As Long, _
        jj      As Long, _
        k       As Integer, _
        l       As Integer, _
        m       As Integer, _
        dz1()   As String, _
        dz2()   As String, _
        dz3()   As String, _
        shv     As Worksheet, _
        shd     As Worksheet
    
    Set shv = Sheets("Veri")
    Set shd = Sheets("Duzenlenmis")
    
    i = 4
    j = 1
    k = shv.Cells(2, Columns.Count).End(1).Column - 3
    
    ReDim dz1(1 To 4)
    ReDim dz2(1 To k)
    ReDim dz3(1 To k)
    
    Do
        dz2(j) = shv.Cells(2, i)
        i = i + 1
        j = j + 1
    Loop Until j > k
    
    Application.ScreenUpdating = False
    
    shd.Cells.ClearContents
    
    shd.Range("A1") = "Poz No"
    shd.Range("B1") = "Poz Tanımı"
    shd.Range("C1") = "Yapı Tipi"
    shd.Range("D1") = "Birimi"
    shd.Range("E1") = "Metraj"
    
    j = 2
    l = 3 + k
    
    For i = 3 To shv.Cells(Rows.Count, "A").End(3).Row
    
        dz1(1) = shv.Cells(i, "A")
        dz1(2) = shv.Cells(i, "B")
        dz1(4) = shv.Cells(i, "C")
        
        For m = 4 To l
            dz3(m - 3) = shv.Cells(i, m)
        Next m
        jj = j + k - 1
        
        shd.Cells(j, "A").Resize(1, 4) = dz1
        shd.Cells(j, "C").Resize(4) = Application.WorksheetFunction.Transpose(dz2)
        shd.Cells(j, "E").Resize(k) = Application.WorksheetFunction.Transpose(dz3)
        
        shd.Range("A" & j & ":A" & jj).FillDown
        shd.Range("B" & j & ":B" & jj).FillDown
        shd.Range("D" & j & ":D" & jj).FillDown
        
        j = j + k
        
    Next i
    
    MsgBox "DÜZENLEME BİTMİŞTİR...", vbInformation, "Necdet YEŞERTENER ----> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    shd.Select
    
    Application.ScreenUpdating = True
    
End Sub