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

Erdogan3434

Altın Üye
Katılım
14 Ocak 2022
Mesajlar
4
Excel Vers. ve Dili
Office 2013 Professional, Türkçe
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

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
3,154
Excel Vers. ve Dili
Ofis 365 Türkçe
Kullandığım kodlar aşağıda.
C++:
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.
 

Ekli dosyalar

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,691
Excel Vers. ve Dili
2010-2016
Aşağıdaki şekilde deneyin.
Kod:
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

Altın Üye
Katılım
14 Ocak 2022
Mesajlar
4
Excel Vers. ve Dili
Office 2013 Professional, Türkçe
Çok teşekkür ediyorum. Ellerinize emeklerinize sağlık.
 
Üst