Sayı Çoğaltma

[mugurlu3428]

Merhabalar Arkadaşlar;

Excelde yazılı olan bir sayı listem var

A1: 1
A2: 2
A3: 3
A4: 4

Ben bu listedeki her sayıyı belirli bir adetde arttırmak istiyorum.Forumda aradım çıok kaynak var fakat farklı kombinasyonlarda bu konuda yardımcı olmanızı istirham ediyorum.

Örnekde A Sütünu Kaynak Liste B Sütünu ise olmasnını istediğim.
Teşekkür ederim.

 

[Necdet]

Selam,

Hiç bir şey anlamadım. Yanlış anlama olmasın diye de uğraşmadım.

Ama yine duramadım. A sütununda maksimum rakamı bulup bunu x kadar yazdırmak istiyorsanız eğer aşağıdaki kodları deneyebilirsiniz.

Adt Değişkenini kaç adet yazdırmak istiyorsanaz belirtiniz. Ben 4 olarak belirledim.

Sub Makro1()

    Dim Mak As Integer, _
        Sat As Long, _
        Adt As Integer
    
    Adt = 4
    
    Mak = WorksheetFunction.Max(Range("A:A")) + 1
    Sat = Cells(Rows.Count, "A").End(3).Row + 1
    Cells(Sat, "A") = Mak
    
    Range("A" & Sat & ":A" & Sat + Adt - 1).FillDown

End Sub

 

[numan şamil]

Bana pek mantıklı gelmedi ama dener misiniz

Sub Numan()
    Dim x, Satır As Long
    Sat = Cells(Rows.Count, "A").End(3).Row 
     Satır = 1
    For x = 1 To Sat
    Range("B" & Satır) = Range("A" & x)
    Range("B" & Satır + 1) = Range("A" & x)
    Range("B" & Satır + 2) = Range("A" & x)
    Range("B" & Satır + 3) = Range("A" & x)
    Range("B" & Satır + 4) = Range("A" & x)
    Range("B" & Satır + 5) = Range("A" & x)
    Range("B" & Satır + 6) = Range("A" & x)
    Range("B" & Satır + 7) = Range("A" & x)
    Range("B" & Satır + 8) = Range("A" & x)
    Range("B" & Satır + 9) = Range("A" & x)
        Satır = Satır + 10
  Next x
End Sub

 

[Merhum İdris SERDAR]

.

Dosyanız ekte.

Kullanılan Formül:

=INDEX($A$1:$A$150;ROUNDUP(ROWS(B$1:B1)/$E$1;0))

$E$1 hücresine tekrar sayısı yazılacak.



.

 

[numan şamil]

Merhaba
makro isterseniz

Sub Numan()
    Dim x, k, Satır As Long
    Sat = Cells(Rows.Count, "A").End(3).Row
     Satır = 1
    For x = 1 To Sat
    a = Range("A" & x)
    For k = 1 To 10
    Range("B" & Satır) = Range("A" & a)
        Satır = Satır + 1
   Next k
  Next x
End Sub

 

[numan şamil]

E1 hücresine yazdığınız kere aynı sayıyı yazdırır

Sub Numan()
    Dim x, k, Satır As Long
     Range("B1:B" & Rows.Count).ClearContents
    Sat = Cells(Rows.Count, "A").End(3).Row
     Satır = 1
    For x = 1 To Sat
    a = Range("A" & x)
    For k = 1 To Range("E1").Value
    Range("B" & Satır) = Range("A" & a)
        Satır = Satır + 1
   Next k
  Next x
End Sub

 

[nazifdural]

Bana pek mantıklı gelmedi ama dener misiniz

Sub Numan()
    Dim x, Satır As Long
    Sat = Cells(Rows.Count, "A").End(3).Row
     Satır = 1
    For x = 1 To Sat
    Range("B" & Satır) = Range("A" & x)
    Range("B" & Satır + 1) = Range("A" & x)
    Range("B" & Satır + 2) = Range("A" & x)
    Range("B" & Satır + 3) = Range("A" & x)
    Range("B" & Satır + 4) = Range("A" & x)
    Range("B" & Satır + 5) = Range("A" & x)
    Range("B" & Satır + 6) = Range("A" & x)
    Range("B" & Satır + 7) = Range("A" & x)
    Range("B" & Satır + 8) = Range("A" & x)
    Range("B" & Satır + 9) = Range("A" & x)
        Satır = Satır + 10
  Next x
End Sub

Bu kodlarda Başka bir sayfaya yazdırmak için nasıl bir değişiklik yapmamız lazım.