Rastgele hücreleri birleştirerek yazma

[Moustapha1983]

Merhaba arkadaşlar... Şöyle bir sorum var benim:

A1'den A20'ye kadar isim soyisim yazacağım ben.

Ali İLERİ
Hasan Ali GÖÇER
...
...
...
...
...

Şeklinde.


Bu 20 hücreden rastgele 5 tanesini seçip B1'e aralarına virgül koyarak yazdırabilir miyiz? Mesela A1, A8, A13, A4, A19 şeklinde. Yalnız bir kere yazılan satırın tekrar yazılmaması gerekiyor.

Eğer B1'e aralarında virgül olarak yazılamıyorsa rastgele seçilen 5 tanesinin B1, B2, B3, B4 ve B5'e alt alta da yazılmasını sağlayabilirseniz de yeterli olacaktır. Aslında bu söylediğimi ben B1'den B5'e kadar olan hücrelere:
=İNDİS(A1:A20;RASTGELEARADA(1;20))
komutuyla yaptım. Fakat daha önce de söylediğim gibi A1 ile A20 arasındaki hücreleri tekrar tekrar kullanmasını istemiyorum. Bunu beceremedim. Bu şekilde yapınca bazen aynı kişiyi iki satıra birden yazıyor.

Şimdiden teşekkür ederim yardımlarınıza

 

[Korhan Ayhan]

Bir KTF hazırladım,




Kullanım şekli;

=K_BENZERSİZ(A1:A20;5;",")

Option Explicit

Function K_BENZERSİZ(Alan As Range, Eleman_Sayısı As Long, Optional Ayıraç As String = ",")
    Dim No As Long, Say As Long
    
    Application.Volatile True
    
    If Alan.Rows.Count < Eleman_Sayısı Then
        K_BENZERSİZ = "Çok fazla eleman sayısı yazdınız!"
        Exit Function
    End If
    
    ReDim Liste(1 To Eleman_Sayısı)
    
    With CreateObject("Scripting.Dictionary")
10      No = WorksheetFunction.RandBetween(1, Alan.Rows.Count)
        If Not .Exists(No) Then
            Say = Say + 1
            .Add No, Say
            Liste(Say) = WorksheetFunction.Index(Alan, No)
        End If
    
        If Say < Eleman_Sayısı Then GoTo 10
    End With
    
    K_BENZERSİZ = Join(Liste, Ayıraç)
End Function

 

[Korhan Ayhan]

Bu da Ofis 365 sürümü için alternatif olsun.

=METİNBİRLEŞTİR(",";;İNDİS(A1:A20;BENZERSİZ(RASGDİZİ(5;1;1;20))))

Harici Link (Silinebilir) ; https://dosyam.org/Y3i/K_BENZERSİZ_FONKSİYONU.xlsm

 

[Moustapha1983]

Bu da Ofis 365 sürümü için alternatif olsun.

=METİNBİRLEŞTİR(",";;İNDİS(A1:A20;BENZERSİZ(RASGDİZİ(5;1;1;20))))

Harici Link (Silinebilir) ; https://dosyam.org/Y3i/K_BENZERSİZ_FONKSİYONU.xlsm


Ekli dosyayı görüntüle 228298

Ücretli üyeliğim olmadığı için 2. mesajınızı kullanmadım fakat 1. mesajınız fazlasıyla işimi gördü. Çok teşekkür ederim.

 

[Korhan Ayhan]

2. mesajımda sizin de indirebilmeniz için harici link paylaştım. Fakat son önerimin siz de çalışması için Ofis 365 sürümüne sahip olmalısınız.

Ek olarak paylaştığım dosyada önerdiğim KTF'de bulunmaktadır.