satırları yer değiştir.

Merhabalar
Mevcut bilgilere karşılık gelen rakamlar sabit kalmak şartıyla satırları yer değiştirmek istiyorum.Karıştır butonu yani.
Merhaba,
Yerlerinin rastgele değişeceğini varsayıyorum. Örnek dosyayı inceleyiniz.
Kod:
Sub Hücre_Karistir()
Dim hcr As Variant, deg1 As Variant, deg2 As Variant
Dim Aralik As Range
Dim x As Long, sayi As Long
Set Aralik = Range("a1:b" & [a65536].End(3).Row)
hcr = Aralik
Randomize
For x = 1 To UBound(hcr, 1)
    sayi = Int(Rnd() * UBound(hcr) + 1)
    deg1 = hcr(x, 1): deg2 = hcr(x, 2)
    hcr(x, 1) = hcr(sayi, 1)
    hcr(x, 2) = hcr(sayi, 2)
    hcr(sayi, 1) = deg1
    hcr(sayi, 2) = deg2
Next x
Aralik = hcr
End Sub
 

Ekli dosyalar

  • Cem.rar
    Cem.rar
    6.6 KB · Görüntüleme: 28
Son düzenleme:
Teşekkür ederim sağolun emeğinize sağlık
 
Geri
Üst