Sütundaki Sayı Kadar Satır Oluşturma

[Erdogan3434]

Merhabalar,

Ben excelde B sütunundaki sayı kadar A hücresindeki metni alt alta yazabilmeyi amaçlıyorum. Bunu yazarken de metnin sonuna 01 ile başlayan sıralı numaralar eklemeye çalışıyorum. Örneği aşağıdaki gibidir.

PLT01	3​	PLT0101
PLT02	4​	PLT0102
		PLT0103
		PLT0201
		PLT0202
		PLT0203
		PLT0204

Teşekkürler.

 

[ÖmerFaruk]

Kullandığım kodlar aşağıda.

Sub YeniListeYap()
    Dim Veri, son As Long, say As Integer, Liste()
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then Exit Sub
    Range("C2:C" & Rows.Count).ClearContents
    Veri = Range("A2:B" & son).Value
    ReDim Liste(1 To WorksheetFunction.Sum(Range("B2:B" & son)), 1 To 1)
    For i = 1 To UBound(Veri)
        For k = 1 To Veri(i, 2)
            say = say + 1
            Liste(say, 1) = Veri(i, 1) & Format(k, "00")
        Next k
    Next i
    Range("C2").Resize(say, 1) = Liste
End Sub

Dosya altın üyeler için ekte ve harici indirme linki aşağıda
Bu linkten indirebilirsiniz.

 

[askm]

Aşağıdaki şekilde deneyin.

Sub askm()
Dim son As Long, t As Long
Dim tekrar As Long
Dim kelime As String
t = 1
son = Range("A" & Rows.Count).End(3).Row
For i = 1 To son
    If Cells(i, 1) <> Empty And Cells(i, 2) <> Empty And IsNumeric(Cells(i, 2)) Then
        tekrar = Cells(i, 2)
        kelime = Cells(i, 1)
        bas = 1
        For k = 1 To tekrar
            Cells(t, 3) = kelime & Format(bas, "0#")
            bas = bas + 1
            t = t + 1
        Next k
    End If
Next i
End Sub

 

[Erdogan3434]

Çok teşekkür ediyorum. Ellerinize emeklerinize sağlık.