merhaba arkadaşlar,

eklediğim örneğin benzeri birçok dosyam var.



1)tablodaki veriyi tersine çevirerek alt alta liste oluşturmak istiyorum,

2)alt alta olan veriyi düzenleme yaptıktan sonra tekrar yanyana 10'arlı liste oluşturmak istiyorum. ( eskisi gibi)

yardımcı olabilirmisiniz?

Turuncu alanin büyüklüğü ve konumu sabit mi?
Kastettiğim sütun sayısı ve verilerin olduğu sütunlar

(30/12/2022, 10:09)berduş yazdı: Turuncu alanin büyüklüğü ve konumu sabit mi?
Kastettiğim sütun sayısı ve verilerin olduğu sütunlar

konumu sabit ama veri alt alta fazla olabiliyor.

1. isteğiniz dikey yapma kodu

Function VeriDikey()

Set Syf = ThisWorkbook.Worksheets("sayfa1")

With Syf

'.Range("A:A").ClearContents

    lr = .Cells(Syf.Rows.Count, "G").End(xlUp).Row

    xDzK = .Range("G3:P" & lr).Value2

    Dim xDzH As Variant

    xByt = UBound(xDzK, 1) * UBound(xDzK, 2)

    ReDim xDzH(1 To xByt, 0)

    For xStr = 1 To UBound(xDzK, 1)

        For xStn = 1 To UBound(xDzK, 2)

'            Debug.Print xDzK(xStr, xStn)

            d = d + 1

                xDzH(d, 0) = xDzK(xStr, xStn)

        Next xStn

    Next xStr

.Range("A3:A" & 2 + xByt) = xDzH

'.Range("G3:P" & lr).ClearContents

End With

End Function

2. isteğiniz yan yana 10arlı liste

Function VeriRange()

Set Syf = ThisWorkbook.Worksheets("sayfa1")

With Syf

    lr = .Cells(Syf.Rows.Count, "A").End(xlUp).Row

    xDzK = .Range("A3:A" & lr).Value2

    Dim xDzH As Variant

    xStrSay = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 'Int(UBound(xDzK, 1) / 10) '+ 1

    ReDim xDzH(0 To xStrSay, 9)

    For x = 0 To UBound(xDzK, 1) - 1

   If Len(xDzK(x + 1, 1) & "") <> 0 Then

        xStn = y Mod 10

        xStr = (y \ 10)

        xDzH(xStr, xStn) = xDzK(x + 1, 1)

    y = y + 1

    End If

    Next x

.Range("G3:P" & 3 + xStrSay) = xDzH

End With

End Function

çok teşekkür ederim, sayenizde tamamdır.

Rica ederim
İyi çalışmalar