işlemi tersine çevirden öte....

[zsafkan]

merhaba,

100 satırlık a sutunundaki 15 farklı verilerin karşısında (b sutununda) yine 15 farklı veri karmaşık olarak sıralanıyor. ben ise b sütünündaki bu dikey dizilişi bu yatay dizilişe çevirmek istiyorum. işlemi tersine çevir işlemi tek tek hammallığa dönüşüyor. Özet tablo yaptım olmadı.lütfen acil cevap bekliyorum.. Örnek tablo ektedir..

 

[Levent Menteşoğlu]

Aşağıdaki kodu "orijinal" isimli sayfanızda oluşturacağınız bir butona bağlayarak çalıştırın.

Sub duzenle()
Application.ScreenUpdating = False
Set s1 = Sheets(1)
Set s2 = Sheets(2)
For a = 2 To s1.[a65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("a2:a" & a), s1.Cells(a, "a")) = 1 Then
c = c + 1
s2.Cells(c + 1, "a") = s1.Cells(a, "a")
son = WorksheetFunction.CountIf(s1.[a:a], s1.Cells(a, "a")) + a - 1
s1.Range("b" & a & ":b" & son).Copy
s2.Cells(c + 1, "b").PasteSpecial Paste:=xlValues, Transpose:=True
End If
Next
Application.CutCopyMode = False
End Sub

 

[Necdet]

Merhaba,

Levent Bey yanıtlamış bende üzerinde çalışmıştım.

Sub Duzenle()
Set s1 = Sheets("Veri")
Set s2 = Sheets("Sonuc")
s1.Select
Application.ScreenUpdating = False
s2.[A2:Z50000].ClearContents
Kolon = s1.[IV1].End(1).Column
Sat = s1.[A65536].End(3).Row
s1.Range(Cells(2, 1), Cells(Sat, Kolon)).Sort Key1:=[A2]
Satir = 1
For i = 2 To Sat
    If s1.Cells(i, "A") <> OncekiReferans Then
        Kolon = 1
        Satir = Satir + 1
        OncekiReferans = s1.Cells(i, "A")
        s2.Cells(Satir, "A") = s1.Cells(i, "A")
    End If
    
    Kolon = Kolon + 1
    s2.Cells(Satir, Kolon) = s1.Cells(i, "B")
Next i
MsgBox "İşlem Tamam...."
End Sub

 

[zsafkan]

teşekkür ediyorum..