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