Bir sütuna yazılan isimleri başka sütuna rastgele dağıtma

[abbasonline]

ekteki excel sayfasında

 

[Korhan Ayhan]

Selamlar,

Tablonuza örnek veriler girerek yeniden eklermisiniz.

 

[abbasonline]

Korhan bey ilgilendiğiniz için teşekkür ederim.

 

[abbasonline]

ekteki dosya ya makroyu nasıl uygulayabilirim.

ekteki dosya ya makroyu nasıl uygulayabilirim, Teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. C sütununa veri girdikçe, girilen veriler B sütununa yeniden rastgele dağıtılır.

Kullanılan kod; (Sayfanın kod bölümüne uygulayın.)

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SATIR As Long, X As Long, SAYI As Long
    
    If Intersect(Target, Range("C3:C65536")) Is Nothing Then Exit Sub
    
    Range("B3:B65536").ClearContents
    SATIR = WorksheetFunction.CountA(Range("C3:C" & Range("C65536").End(3).Row)) + 2
    
    Randomize
    
    For X = 3 To SATIR
Tekrar: SAYI = Int(SATIR * Rnd + 1)
        If SAYI < 3 Then GoTo Tekrar
        If WorksheetFunction.CountIf(Range("B:B"), Cells(SAYI, "C")) > 0 Then GoTo Tekrar
        Cells(X, "B") = Cells(SAYI, "C")
    Next
End Sub

 

[abbasonline]

Korhan bey teşekkür ederim, ancak isimleri

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub VERİLERİ_RASTGELE_DAĞIT()
    Dim SATIR As Long, X As Long, SAYI As Long
    
    Range("B3:B65536").ClearContents
    
    SATIR = WorksheetFunction.CountA(Range("C3:C" & Range("C65536").End(3).Row)) + 2
    
    Randomize
    
    For X = 3 To SATIR
Tekrar: SAYI = Int(SATIR * Rnd + 1)
        If SAYI < 3 Then GoTo Tekrar
        If WorksheetFunction.CountIf(Range("B:B"), Cells(SAYI, "C")) > 0 Then GoTo Tekrar
        Cells(X, "B") = Cells(SAYI, "C")
    Next
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[abbasonline]

ekte dosya yok korhan bey veya göremedim.

 

[Korhan Ayhan]

Selamlar,

Örnek dosya eklemedim. Eklememe gerek var mı?

Sadece verdiğim kodu bir butona atayıp kullanacaksınız.

 

[abbasonline]

Korhan bey, sağolun.

 

[Korhan Ayhan]

Selamlar,

Daha önce bu işlemin nasıl yapılacağı konusunda resimli bir anlatım hazırlamıştım. İncelermisiniz.

http://www.excel.web.tr/showthread.php?t=59436

 

[abbasonline]

Teşekkürler,