Bir hücreye girilen değer kadar veri yazdırma

[tropique]

Merhaba,

Benim sorunum, bir hücreye girilen metni yanındaki hücredeki sayı kadar bir başka sütunda tekrar ettirmek.

Aslında özet tabloya giden yolu tersten almak. Örnek ektedir.

Teşekkür ederim

 

[suleyman242]

Merhaba,

Benim sorunum, bir hücreye girilen metni yanındaki hücredeki sayı kadar bir başka sütunda tekrar ettirmek.

Aslında özet tabloya giden yolu tersten almak. Örnek ektedir.

Teşekkür ederim

Dosya ekledim .

 

[tropique]

Çok teşekkür ederim, tam derdimin dermanı olmuş.
Allah razı olsun.

Dosya ekledim .

 

[suleyman242]

Çok teşekkür ederim, tam derdimin dermanı olmuş.
Allah razı olsun.

Bende teşekkür ederim Kolay gelsin.

 

[Necdet]

Merhaba,

Bu çözümde alternatif olsun. Hücre hücre değil de Range olarak aktarım.

Private Sub CommandButton1_Click()
    
    Dim i   As Long, _
        j   As Long, _
        Son As Long, _
        Sat As Long
    
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, "A").End(3).Row
    If Son < 4 Then Son = 5
    Sat = Cells(Rows.Count, "E").End(3).Row
    If Sat < 5 Then Sat = 5
    Range("E5:E" & Sat).ClearContents
    Sat = 5
    
    For i = 5 To Son
        j = Sat + Cells(i, "B") - 1
        Range("E" & Sat & ":E" & j) = Cells(i, "A")
        Sat = j + 1
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem tamamlanmıştır....", vbInformation, "excel.web.tr"
    
End Sub

 

[tropique]

Size de teşekkür ederim ancak no:1 - 2 - ... şeklinde numaralandırma yapmıyor.

İlgi ve emeğiniz için teşekkürler.

Merhaba,

Bu çözümde alternatif olsun. Hücre hücre değil de Range olarak aktarım.

Private Sub CommandButton1_Click()
    
    Dim i   As Long, _
        j   As Long, _
        Son As Long, _
        Sat As Long
    
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, "A").End(3).Row
    If Son < 4 Then Son = 5
    Sat = Cells(Rows.Count, "E").End(3).Row
    If Sat < 5 Then Sat = 5
    Range("E5:E" & Sat).ClearContents
    Sat = 5
    
    For i = 5 To Son
        j = Sat + Cells(i, "B") - 1
        Range("E" & Sat & ":E" & j) = Cells(i, "A")
        Sat = j + 1
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem tamamlanmıştır....", vbInformation, "excel.web.tr"
    
End Sub

 

[Necdet]

Numaralandırmayı görmemişim