Çözüldü Sayfadaki İsimlerin karşılarındaki Belirlenen Sayı Kadar Farklı Bir Hucrede Yazılması Hk.

skaan

Altın Üye
Katılım
11 Mart 2005
Mesajlar
257
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
30-10-2024
Merhaba;

Örnek ekte bulunan dosyamdan yola çıkarak A sutunu > kullanıcı adı : sweffe0 B sutunu > çekiliş hakkı : 396
D sutununda D2 hücresinden başlayarak alt alta bu kullanıcının adının 396 kere yazmasını sağlamak istemekteyim.
396 kere çekiliş hakkı sutunundaki sayıya göre alt alta yazdıktan sonra bır alt sırasında bulunan aslan0807 nın adını da çekiliş hakkı 365 kere olduğu
için onuda yine kaldığı yerden alta dogru 365 kere devam etmesini istiyorum.. Bu işlem sırayla kullanıcı adı sutunundaki yazan isimlere uygulanacak
karşılarındaki sayılar kadar.. Bu işlemi yapmamda yardımcı olmanızı rica ediyorum..
Saygılarımla;
Skaan
 

Ekli dosyalar

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,781
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Merhaba Arkadaşım,
B sütunundaki değerleri TAMSAYI haline getirirseniz her zaman doğru sonuç alırsınız
İyi çalışmalar
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhba,
Deneyiniz.
Kod:
Public Sub Deneme()

Dim arr1 As Variant, _
    arr2 As Variant, _
    i   As Long, _
    j   As Long, _
    k   As Long

Application.ScreenUpdating = False

i = Cells(Rows.Count, "B").End(3).Row
j = Application.WorksheetFunction.Sum(Range("B2:B" & i))

Columns("D:D").ClearContents

arr1 = Range("A1").CurrentRegion.Value
arr2 = Range("D1:D" & j + 1).Value

arr2(1, 1) = arr1(1, 1)

k = 1
For i = 2 To UBound(arr1, 1)
    For j = 1 To arr1(i, 2)
        k = k + 1
        arr2(k, 1) = arr1(i, 1)
    Next j
Next i

Range("D1").Resize(UBound(arr2, 1), 1) = arr2

Application.ScreenUpdating = True
MsgBox "Liste Hazır..."

End Sub
 

skaan

Altın Üye
Katılım
11 Mart 2005
Mesajlar
257
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
30-10-2024
Sayın ;
Tevfik_Kursun
Necdet

Yardımlarınız için çok teşekkür ederim. Hayırlı günler iyi bayramlar diliyorum..
Saygılarımla;
Skaan
 
Üst