hücre içi karıştırma

[FDUYAR]

Arkadaşlar merhaba,
Bir hücre içerisinde aşağıdaki değerler var.

Ahmet
Mehmet
Ali
Veli

Fakat bunlar bir hücre içerisinde alt altta yazılı (notepad'den yapıştırılmış) yani her biri bir satırda değil.

Ben bu hücreyi aşağıya doğru çektikçe, her satırda içeriğin karışmasını istiyorum. Örneğin bir alt satırdaki hücrenin içeriği :
Veli
Mehmet
Ali
Ahmet ... olmalı

bir alt satır ise;
Ali
Mehmet
Veli
Ahmet

bu şekilde bir karıştırma yapsın isyorum. Şunu belirteyim gerekirse her bir isimden sonra virgül koyabilirim yani ilk satırda hücrenin içeriği aşağıdaki gibi olabilir.
Ahmet,
Mehmet,
Ali,
Veli,

Yardımlarınız için şimdiden teşekkürler.

 

[FDUYAR]

bu arada excel 2013 kullanıyorum

 

[FDUYAR]

bi el atın ustadlar

 

[Haluk]

Veriler tekrar edebilir mi?

Örneğin;

Ali
Veli
Veli
Ali

gibi ....

.

 

[FDUYAR]

Veriler tekrar edebilir mi?

Örneğin;

Ali
Veli
Veli
Ali

gibi ....

.

cevabınız için teşekkürler. Hayır tekrar etmemeli.

 

[leumruk]

Selamlar,
Örneği inceleyiniz.

=KIRP(PARÇAAL(YERİNEKOY(A$1;" ";YİNELE(" ";UZUNLUK($A$1)));(MOD(AŞAĞIYUVARLA(MOD((SATIR(A1)-1)/4;4)+1;0)+SATIR(A1)-2;4)+1)*UZUNLUK($A$1)-(UZUNLUK($A$1)-1);UZUNLUK($A$1)))

 

[Korhan Ayhan]

Alternatif olarak aşağıdaki kodu deneyiniz.

Option Base 1
Option Explicit

Sub KARIŞTIR()
    Dim X As Long, Y As Long, Veri As Variant, Say As Long
    Dim Sayi As Variant, Dizi As Object, Liste As String
    
    Randomize Timer

    Set Dizi = CreateObject("Scripting.Dictionary")
    Veri = Split(Range("A1"), Chr(10))
    Say = UBound(Veri) + 1
    
    For X = 1 To 100
        For Y = 1 To Say
10          Sayi = Int(Say * Rnd() + 1)
            If Dizi.Count = Say Then GoTo 20
            If Not Dizi.Exists(Sayi) Then
                Dizi.Add Sayi, Sayi
            Else
                GoTo 10
            End If
        Next
    
20      For Each Sayi In Dizi.Items
            Liste = IIf(Liste = "", Veri(Sayi - 1), Liste & Chr(10) & Veri(Sayi - 1))
        Next
        
        Cells(X + 1, 1) = Liste
        Liste = ""
        Dizi.RemoveAll
    Next
    
    Set Dizi = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[FDUYAR]

teşekkürler deneyip bilgi vereceğim

 

[FDUYAR]

Option Base 1 Option Explicit Sub KARIŞTIR() Dim X As Long, Y As Long, Veri As Variant, Say As Long Dim Sayi As Variant, Dizi As Object, Liste As String Randomize Timer Set Dizi = CreateObject("Scripting.Dictionary") Veri = Split(Range("A1"), Chr(10)) Say = UBound(Veri) + 1 For X = 1 To 100 For Y = 1 To Say 10 Sayi = Int(Say * Rnd() + 1) If Dizi.Count = Say Then GoTo 20 If Not Dizi.Exists(Sayi) Then Dizi.Add Sayi, Sayi Else GoTo 10 End If Next 20 For Each Sayi In Dizi.Items Liste = IIf(Liste = "", Veri(Sayi - 1), Liste & Chr(10) & Veri(Sayi - 1)) Next Cells(X + 1, 1) = Liste Liste = "" Dizi.RemoveAll Next Set Dizi = Nothing MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub

teşekkürler çalıştı