Ekurs işlemleri için küçük bir yardıma ihtiyacım var.

[demgüzar]

Öncelikle herkese merhaba, excel konusunda bilgim çok sınırlı. Sizin için basit ama benim için çok önemli bir konuda yardıma ihtiyacım var. Basitçe anlatırsam:

A sütununda isimler B sütununda da adetler var. Bana C sütununa A sütunundaki ismi b sütunundaki sayı kadar alt alta yazan bir koda ihtiyacım var. Bir de D sütununa a sütunundaki ismi kaç kez yazdıysa d sütununa da sıralı olarak yazacak. Yani A ve B sütunundaki verileri C ve D sütunundaki şekle getirecek. Yardım edebilirseniz çok memnun olurum.


Örnek Dosya

Örnek dosya.xlsx

Sayfa1 SONUÇ AHMET,5,AHMET,1 MEHMET,2,AHMET,2 ALİ,6,AHMET,3 AHMET,4 AHMET,5 MEHMET,1 MEHMET,2 ALİ,1 ALİ,2 ALİ,3 ALİ,4 ALİ,5 ALİ,6

docs.google.com

 

[Necdet]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Public Sub Deneme()

Dim i   As Long, _
    fRow As Long, _
    lRow As Long

    Sayfa1.Range("D1").CurrentRegion.Offset(1).ClearContents
    fRow = 2
For i = 2 To Sayfa1.Cells(Rows.Count, "A").End(3).Row
    lRow = fRow + Sayfa1.Cells(i, "B") - 1
    Sayfa1.Range("D" & fRow & ":D" & lRow) = Sayfa1.Cells(i, "A")
    Sayfa1.Range("E" & fRow) = 1
    Sayfa1.Range("E" & fRow & ":E" & lRow).DataSeries
    fRow = Range("D1").End(xlDown).Row + 1
Next i

End Sub

 

[Tevfik_Kursun]

Sayın Necdet Hocam,
Resimdeki örnek oluşuyor. (benim de benzer bir makroya ihtiyacım var da, o nedenle araya girdim)
Saygılarımla

 

[Necdet]

Tevfik bey, sizin de işinize yaradığına sevindim.
Güle güle kullanınız.

 

[Tevfik_Kursun]

Sağolun Necdet Hocam, ama beklenen olmuyor
Saygılarımla

 

[Necdet]

D1 hücresini doldurursanız, sonuca ulaşırsınız Tevfik bey,

 

[Tevfik_Kursun]

Sayın Necdet Hocam,
Çok teşekkür ederim. Elinize sağlık. (D3 ten başlatmak için ne yapmak gerek?)
Saygılarımla

 

[Necdet]

Kodlardaki değişikliği şu şekilde yapabilirsiniz.

Sayfa1.Range("D2").CurrentRegion.Offset(1).ClearContents
fRow = 2

 

[Tevfik_Kursun]

Günaydın Sayın Necdet Hocam,
A sütunu A1 den başlarken D sütunu D3 ten başlamasın başaramadım

    Range("D1").CurrentRegion.Offset(1).ClearContents
    fRow = 1
        For i = 1 To Sayfa1.Cells(Rows.Count, "A").End(3).Row

Bunu tercih ettim.
İlginize çok teşekkür ederim.
Saygılarımla

 

[demgüzar]

Public Sub Deneme() Dim i As Long, _ fRow As Long, _ lRow As Long Sayfa1.Range("D1").CurrentRegion.Offset(1).ClearContents fRow = 2 For i = 2 To Sayfa1.Cells(Rows.Count, "A").End(3).Row lRow = fRow + Sayfa1.Cells(i, "B") - 1 Sayfa1.Range("D" & fRow & "" & lRow) = Sayfa1.Cells(i, "A") Sayfa1.Range("E" & fRow) = 1 Sayfa1.Range("E" & fRow & ":E" & lRow).DataSeries fRow = Range("D1").End(xlDown).Row + 1 Next i End Sub

Necdet Bey, ilginiz için çok teşekkür ederim. Kodları denedim, D1 hücresini doldurunca kod istediğim gibi çalıştı. Yardımsever insanlar iyi ki varlar

 

[Tevfik_Kursun]

Günaydın Sayın Necdet Hocam,
A sütunu A1 den başlarken B sütununda B1=1 se hata veriyor. Onun dışında şahane çalışyor.
Çözmek kolay mıdır, bilemedim.
Saygılarımla

 

[Necdet]

Aşağıdaki kodlar 1. satırdan başlayan veriler için.

Public Sub Deneme()

Dim i   As Long, _
    fRow As Long, _
    lRow As Long

    Sayfa1.Range("D1").CurrentRegion.ClearContents
    fRow = 1
For i = 1 To Sayfa1.Cells(Rows.Count, "A").End(3).Row
    lRow = fRow + Sayfa1.Cells(i, "B") - 1
    Sayfa1.Range("D" & fRow & ":D" & lRow) = Sayfa1.Cells(i, "A")
    Sayfa1.Range("E" & fRow) = 1
    Sayfa1.Range("E" & fRow & ":E" & lRow).DataSeries
    fRow = Sayfa1.Cells(Rows.Count, "D").End(3).Row + 1
Next i

End Sub

 

[Tevfik_Kursun]

İlginize teşekkür ederim Necdet Hocam,
Çok önemli değildi. Ama sağolun.
Saygılarımla

 

[Necdet]

Merhaba,
12. mesaj isteğinizi karşılıyor Tevfik bey

 

[Tevfik_Kursun]

Sayın Necdet Hocam,
12. meajınızdaki makroyu şimdi gördüm. Daha önce vadı da ben mi görmedim. Öyleyse kusuruma bakmayın lütfen.
Elinize sağlık, çok teşekkür ederim.
Saygılarımla

 

[Necdet]

Sayın Necdet Hocam,
12. meajınızdaki makroyu şimdi gördüm. Daha önce vadı da ben mi görmedim. Öyleyse kusuruma bakmayın lütfen.
Elinize sağlık, çok teşekkür ederim.
Saygılarımla

sizden biraz önce yüklemişim