sayı kadar taksit adedi

[Barons]

merhaba
Ekteki B4 hücresindeki sayı kadar A7'den itibaren olmasını makro ile nasıl sağlarım,yani B4 değeri örnek; 10 ise A7'den itibaren 1...10'a kadar sayı yazmasını istiyorum.14 ise 1...14 e kadar gibi.

çok teşekkürler

 

[İhsan Tank]

merhaba
Ekteki B4 hücresindeki sayı kadar A7'den itibaren olmasını makro ile nasıl sağlarım,yani B4 değeri örnek; 10 ise A7'den itibaren 1...10'a kadar sayı yazmasını istiyorum.14 ise 1...14 e kadar gibi.

çok teşekkürler

merhaba
boş bir module ekleyerek dener misiniz

Option Explicit
Sub sıra()
Dim ts, kaplan
kaplan = MsgBox(Sheets("Sayfa1").Range("B4") & " Sıra No Çıkarılıyor", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
kaplan = Sheets("Sayfa1").Range("A65536").End(xlUp).Row
ts = 6 + Sheets("Sayfa1").Range("B4")
Sheets("Sayfa1").Range("A7:A" & kaplan).ClearContents
Sheets("Sayfa1").Range("A7") = 1
Sheets("Sayfa1").Range("A7:A" & ts).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, step:=1, Trend:=True
MsgBox Sheets("Sayfa1").Range("B4") & " Sıra No Çıkarıldı", vbInformation, "Bitiş"
End Sub

 

[quesh]

Sub Taksit()


m = 6
Do Until Sheets(1).Cells(m, 1) = ""
    m = m + 1
Loop
'Bir Önceki Taksit Hesabımızı Temizlemek İçin Dolu Olan Son Hücrenin Satır Sayısını Bulduk(m.satır)

For q = 7 To m - 1
    Sheets(1).Cells(q, 1) = ""
Next
'7.satırdan başlayarak m-1'nci satıra kadar olan hücreleri temizledik.


Dim a As Integer

a = Sheets(1).Range("B4")
    
'Alttaki döngünün kaçıncı satıra kadar devam edeceğini bulmak için yukarda Bir a değeri tanımadık ve bunu da taksit sayısı olan B4 hücresine eşitledik.

Cells(7, 1).Value = 1
'7.satır 1.sütun değeri bizim için hep 1 değerini alacağından bu hücreye 1 değerini atadık

For i = 7 To a + 5
    Cells(i + 1, 1) = Cells(i, 1).Value + 1
Next

'7.satırdan başlayıp a+5'nci satıra kadar olan satırları üstteki satırın bir fazlası değere eşitledik.



End Sub

 

[EErkut]

Formul kullanarak yapılmıştır.

 

[Barons]

Çok teşekkürler yardımlarınız için.hayırlı işler.

 

[İhsan Tank]

Çok teşekkürler yardımlarınız için.hayırlı işler.

rica ederim
:yazici: