Verileri rastgele karıştırmak

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
382
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba,
Bir çalışmam gereği ekte bulunan dosyanın verilerini rastgele karıştırmak istiyorum. İstediğim şey şu ; A, B ve C sütunları birbirinden bağımsız biçimde kendi içerisinde karışacak, geri kalan sütunlar birbirleri ile karışacak. yani A sütunu sadece A sütunu içerisinde karışsın. B sadece b içerisinde, c'de aynı şekilde. geri kalan sütünlar da örneğin ; D sütunundakiler e ile karışabilir veya f ile.. a,b,c hariç geri kalanların çok karışması lazım kısaca, böyle bir şey mümkün müdür, Yardım edebilir misiniz ? :) Yardımlarınız için şimdiden teşekkür ederim.

Örnek dosya :
https://dosya.co/zxyoypplsjn7/Kitap1.xlsx.html
 
Son düzenleme:

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,108
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Aşağıdaki kodu deneyiniz.
PHP:
Sub kod()
alan = Array("A1:A44", "B1:B44", "C1:C44", "D1:Y44")
Application.ScreenUpdating = False
Randomize
For Each al In alan
    For a = 1 To Range(al).Cells.Count
        x = Int(Rnd() * Range(al).Cells.Count + 1)
        y = Range(al).Cells(a).Value
        Range(al).Cells(a).Value = Range(al).Cells(x).Value
        Range(al).Cells(x).Value = y
    Next
Next
Application.ScreenUpdating = True
End Sub

Kodun baş tarafını şu şekilde düzenlerseniz de A sütunundaki son dolu hücreye göre dinamik alan tanımlamış olursunuz.
Kod:
s = Cells(Rows.Count, "A").End(3).Row
alan = Array("A1:A" & s, "B1:B" & s, "C1:C" & s, "D1:Y" & s)
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
382
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba,
Aşağıdaki kodu deneyiniz.
PHP:
Sub kod()
alan = Array("A1:A44", "B1:B44", "C1:C44", "D1:Y44")
Application.ScreenUpdating = False
Randomize
For Each al In alan
    For a = 1 To Range(al).Cells.Count
        x = Int(Rnd() * Range(al).Cells.Count + 1)
        y = Range(al).Cells(a).Value
        Range(al).Cells(a).Value = Range(al).Cells(x).Value
        Range(al).Cells(x).Value = y
    Next
Next
Application.ScreenUpdating = True
End Sub
Ömer Hocam çok teşekkür ederim, ellerinize sağlık. Harika oldu :)
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,108
Excel Vers. ve Dili
2007 Türkçe
Rica ederim, bir önceki mesaja ilave yapmıştım isterseniz o şekilde de kullanabilirsiniz.
İyi çalışmalar...
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
382
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Rica ederim, bir önceki mesaja ilave yapmıştım isterseniz o şekilde de kullanabilirsiniz.
İyi çalışmalar...
dinamik alan kısmını anlamadım sayın Ömer Bey, dinamik alanın avantajı veya katkısı nedir açıklayabilir misiniz ?
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,108
Excel Vers. ve Dili
2007 Türkçe
Şu an 44 satır veriniz var ama bu miktar yani satır sayınız artarsa ya da eksilirse kodda değiştirme yapmanıza gerek kalmayacak. Kod A sütunundaki son dolu hücreye göre son satırı otomatik bulacak.
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
382
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Şu an 44 satır veriniz var ama bu miktar yani satır sayınız artarsa ya da eksilirse kodda değiştirme yapmanıza gerek kalmayacak. Kod A sütunundaki son dolu hücreye göre son satırı otomatik bulacak.
bir sonraki adımda ihtiyacım olacak şeyi şimdiden çözdünüz, çok teşekkür ediyorum size :)
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,108
Excel Vers. ve Dili
2007 Türkçe
Rica ederim,
Hayırlı geceler, iyi çalışmalar...
 
Üst