seçili alandaki verileri rastgele dağıtmak

[peleryn]

Herkese Merhabalar;

Çalışma sayfası içinde A sütunu veya C sütununda seçeceğim herhangi bir alanda bulunan hücrelerdeki verilerin yine aynı alan içinde yerlerini rastgele değiştirmek istiyorum..

Bunun için nasıl bir kod kullanabilirim?

İlgilenecek herkese çok teşekkür ederim..

 

[Orion1]

Herkese Merhabalar;

Çalışma sayfası içinde A sütunu veya C sütununda seçeceğim herhangi bir alanda bulunan hücrelerdeki verilerin yine aynı alan içinde yerlerini rastgele değiştirmek istiyorum..

Bunun için nasıl bir kod kullanabilirim?

İlgilenecek herkese çok teşekkür ederim..

Hep örnek dosya diyoruuuum.
Dilimde tüy bitti.
Yani bunun dosyasınıda biz hazırlamayalım.Nede olsa size lazım diilmi.Hazırlayıp önümeze verin ki bunlarlada uğraşmayalım.

 

[leumruk]

Merhaba,
A ya da C sütunundan alan seçip butona basın.

Private Sub CommandButton1_Click()
If Selection.Count <= 1 Then Exit Sub
If ActiveCell.Column = 1 Or ActiveCell.Column = 3 Then
Dim q As Variant, r As Variant
Dim random As Range
Dim x As Long, y As Long
Set Aralik = Selection
q = Aralik.Value
Randomize
For x = 1 To UBound(q, 1)
    y = Int(Rnd() * UBound(q) + 1)
    r = q(x, 1)
    q(x, 1) = q(y, 1)
    q(y, 1) = r
Next x
Aralik.Value = q
End If
End Sub

 

[peleryn]

Hocam haklısınız da örnek dosya olarak çok çok vereceğim A ve C sütunlarında birkaç veri olan sade bir dosya..3-4 tane veriyi yazmak buradan dosyayı indirmekten daha kısa olur diye düşündüğümden dosya eklemedim.Böyle düşünerek incelik yaptığımı sanıyordum ama yanılmışım özür dilerim..

 

[peleryn]

leumruk hocam;

Çok teşekkür ederim kullandığınız verilerin bulunduğu dosyamda kodlarınızı uyarlamaya çalışmış ama yapamamıştım.Ellerinize sağlık gayet güzel çalışıyor çok teşekkür ederim.

 

[Orion1]

Dosyanız ektedir.

Sub secili_dagit()
Dim hcr As Range, col As Collection, sayi As Double
Randomize Timer
Set col = New Collection
For Each hcr In Selection
    If hcr.Column = 1 Or hcr.Column = 3 Then col.Add hcr.Value
Next
For Each hcr In Selection
    If hcr.Column = 1 Or hcr.Column = 3 Then
        sayi = Int(Rnd() * col.Count) + 1
        If col.Count >= 1 Then hcr.Value = col(sayi)
        col.Remove (sayi)
    End If
Next
End Sub

 

[Orion1]

Bir yerde unuttum hata yapmışım.Benzersiz seçim ile ilgili.
Dosyayı düzenledim.
Önceki mesajımdan indirebilirsiniz.

 

[peleryn]

Evren Hocam;

Çözümünüz için teşekkür ederim ancak butona bastığımda değerler dağılırken değişiyor..Sadece seçili alandaki değerlerle ve değiştirmeden sadece yine seçili alandaki yerlerini değiştirerek işlem yapması gerekiyor.

 

[Orion1]

Evren Hocam;

Çözümünüz için teşekkür ederim ancak butona bastığımda değerler dağılırken değişiyor..Sadece seçili alandaki değerlerle ve değiştirmeden sadece yine seçili alandaki yerlerini değiştirerek işlem yapması gerekiyor.

7 numaralı mesajımı okudunuzmu?

 

[peleryn]

İkinci dosyanızı da denedim benzer sorun devam ediyor hocam.

 

[peleryn]

Hocam ikinci dosya doğru çalışıyor yanlışlık oldu özür dilerim.Ellerinize sağlık ilginiz ve çözümünüz için çok teşekkür ederim.

 

[Orion1]

İkinci dosyanızı da denedim benzer sorun devam ediyor hocam.

Nasıl anlamdım.
A sütunundaki lerin a sütunundaki değerlerele c sütununun C sütundakilerlemi değeşitirilmesini istiyorsunuz
Benim yaptığımda bir havuz yaptım.
O havuza asütunda ve C sütunda seçili olan değerleri attım.
Sonra yine seçili alanlarda a ve c sütunlarına o havıuzdan rastgele seçtiğim değperleri yazdım.Siz nasıl istiyorsunuz?

 

[Orion1]

Hocam ikinci dosya doğru çalışıyor yanlışlık oldu özür dilerim.Ellerinize sağlık ilginiz ve çözümünüz için çok teşekkür ederim.

Benimde ödüm koptu.
Niye olmuyor diye.

 

[peleryn]

Siz yaparsınız da olmaz mı hocam nerde görülmüş öyle şey

Size ve leumruk hocama tekrar teşekkür ediyorum ellerinize sağlık..