Tablo dönüştürme

[dauntless]

Merhaba,

data sayfasında bulunan tabloyu target sayfasındaki gibi dikey listeye donusturmek istiyorum. Bu şekilde listeye donusurken icerisinde deger bulunmayan degerleri taşımaması gerekiyor. Aslında Pivot sayfasındaki gibi bir pivot ile de halletmeye calıstım ama orada deger bulunmayan hucreler de bos olarak pivot tabloya geldi. Bunu VBA ile nasıl yapabilirim?

Tesekkurler

dosya:

http://s6.dosya.tc/server7/itdrvh/problem.xlsx.html

 

[YUSUF44]

Target sayfasında 4. satırdan itibaren verileri silin, yani sadece başlıklar kalsın. Daha sonra aşağıdaki kodları dosyada bir modüle kopyalayıp deneyin:

Sub tablo()
Set s1 = Sheets("data")
Set s2 = Sheets("Target")

son = s1.Cells(Rows.Count, "A").End(3).Row

For satır = 2 To son
    For sütun = 3 To 7
        If s1.Cells(satır, sütun) <> "" Then
            yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s2.Cells(yeni, "A") = s1.Cells(satır, "A")
            s2.Cells(yeni, "B") = s1.Cells(satır, "B")
            s2.Cells(yeni, "C") = s1.Cells(1, sütun)
            s2.Cells(yeni, "D") = s1.Cells(satır, sütun)
        End If
    Next
Next
End Sub

 

[dauntless]

Teşekkürler. birşey daha soracağım; A1 hücresinde yazacağım bir değere göre sadece o değere ait satırları getirebilmek için ne yapabilirim? Dosyada örnek olarak A1 hücresine yazmıştım.

 

[YUSUF44]

aşağıdaki kod istediğinizi yapıyor:

Sub tablo2()
Set s1 = Sheets("data")
Set s2 = Sheets("Target")

son = s1.Cells(Rows.Count, "A").End(3).Row
[B][COLOR="Red"]aranan = s2.[A1].Value[/COLOR][/B]
For satır = 2 To son
    [COLOR="red"][B]If s1.Cells(satır, "A") = aranan Then[/B][/COLOR]
        For sütun = 3 To 7
            If s1.Cells(satır, sütun) <> "" Then
                yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
                s2.Cells(yeni, "A") = s1.Cells(satır, "A")
                s2.Cells(yeni, "B") = s1.Cells(satır, "B")
                s2.Cells(yeni, "C") = s1.Cells(1, sütun)
                s2.Cells(yeni, "D") = s1.Cells(satır, sütun)
            End If
        Next
   [B][COLOR="red"] End If[/COLOR][/B]
Next
End Sub