sayıları belirletiğim satıra kadar yazıp devamını yan sütuna aktarması

[Mx@Raid]

Arkadaşlar basit makro üzerinde uğraşırken aklıma geldi. Örneğin benim belirlediğim oranda sayıyı yazacak, bununla birlikte yine benim belirlediğim miktar kadarını bir sütuna yazıp diğer sütuna aktaracak tabi bunu her seferinde belirlenen satır kadar yazıp diğer sütuna geçecek. Örneğin 5 satıra kadar girdiğim aralıktaki sayıyı yazıp B sütununa yazacak, sonra C .. bu şekilde sayılar bitene kadar bu işemi yapacak. Dosya oluşturdum ancak yan sütuna aktarmayı halledemedim.

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodları aşağıdaki şekilde değiştirip denermisiniz. A4 hücresinede verileri yazdırmak istediğiniz satır sayısını yazıp kodu deneyiniz.

Sub Sayı()
    Sütun = 2
 
    For X = Range("A1") To Range("A2")
        Satır = Satır + 1
            If Satır > Range("A4") Then
                Satır = 1
                Sütun = Sütun + 1
            End If
        Cells(Satır, Sütun) = X
    Next
End Sub
 
Sub Sil()
    Range("B1:IV65536").ClearContents
End Sub

 

[halit3]

A1 hücrasine yazdığın sayı kadar aktarım yapıyor

Sub aktar()
If Val(Worksheets(ActiveSheet.Name).Cells(1, 1).Value) > 0 Then
If Val(Worksheets(ActiveSheet.Name).Cells(2, 1).Value) > 0 Then
sut = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:IV1")) + 1
sat = Worksheets(ActiveSheet.Name).Cells(1, 1).Value
sat1 = Worksheets(ActiveSheet.Name).Cells(2, 1).Value
sat2 = 1
For i = sat To sat1
Worksheets(ActiveSheet.Name).Cells(sat2, sut).Value = i
sat2 = sat2 + 1
Next i
MsgBox "işlem tamam"
Else
MsgBox "A2 Hücresinde sayı yok"
End If
Else
MsgBox "A1 Hücresinde sayı yok"
End If
End Sub

 

[halit3]

ben farkında değildim korhan ayhan bey yanıtlamış alternatif olur belkide

 

[Mx@Raid]

Arkadaşlar her ikiniz de teşekkür ederim ancak ifade şeklim yanlış oldu galiba. Şöyle ifade edeyim.
Varsayalım 8 ile 24 arası rakamları istedim;

B C D
8 14 20
9 15 21
10 16 22
11 17 23
12 18 24
13 19
gibi. Tabi burada sütunda kaç rakam olmasını istiyorsam ona göre işlem yapacak

 

[leumruk]

Merhaba,
Aşağıdaki gibi deneyiniz.

Sub Sayı()
If [b1] = "" Or [b2] = "" Or [b3] = "" Or [b1] > [b2] Then
MsgBox "Kriter tablosunda boş hücre var ya da sayı alt limitini sayı üst limitinden büyük girmişsiniz. Lütfen kriter tablonuzu kontrol ediniz."
Exit Sub
End If
Range("d1:z65536").ClearContents
Sat = 1
Sut = 4
sayi = [b1]
For x = [b1] To [b2]
    Cells(Sat, Sut) = sayi
    sayi = sayi + 1
    Sat = Sat + 1
        If Sat - 1 >= [b3] Then
            Sut = Sut + 1
            Sat = 1
        End If
Next
End Sub

 

[Korhan Ayhan]

Selamlar,

A1 hücresine 8 yazın.
A2 hücresine 24 yazın.
A4 hücresinede 5 yazın ve önerdiğim kodu deneyin.

Her sütuna 5 satır veri yazarak işlemi bitirecektir. Sizin istediğiniz işlemde bu değilmiydi?

 

[Mx@Raid]

Arkadaşlar herbirinize ayrı ayrı teşekkürler. İstediğim sonucu elde ediyor; hepinizin yüreğine emeğine sağlık.