Satırları rasgele karıştırma?

[Gorarr]

Yapmak istediğim sadece satırların hizası bozulmadan random karışması. Tüm sayfa içinde olabilir aralık belirtmelide olabilir.

Yardımlarınız için şimdiden çok teşekkür ederim.

 

[uzmanamele]

merhaba

bu kod işinizi görür mü?

Sub karistir()
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(1,14)"
    Selection.AutoFill Destination:=Range("G1:G14")
    Range("G1:G14").Select
    ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Add Key:=Range("G1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa2").Sort
        .SetRange Range("A1:G14")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        Range("G1:G14").ClearContents

End Sub

 

[Gorarr]

Hocam öncelikle teşekkür ederim işimi görüyor. Ama çoğu kez diğer sütunlarada veri girişi yapmam gerektiğinde kodu modifiye etmem gerekicek aceba daha az karmaşık bir kod mümkünmü. değilse sağlık olsun. Tekrardan ellerinize sağlık.

 

[Gorarr]

Terkrar selamlar, dosyaya satır yada sütun eklediğim zaman bu kod malesef işime yaramıyor. Modifiye etmeye çalıştım ama yine olmuyor. Örnek dosyamıda yeniledim. Yardımlarınızı bekliyorum. Teşekkürler.

 

[Necdet]

Merhaba,

Alternatif Aşağıdaki kodları dener misiniz, umarım doğru anlamışımdır.

Sub KarisikSirala()
 
    Dim i   As Long, _
        Kol As Integer, _
        Sat As Long
 
    Kol = Cells(1, Columns.Count).End(1).Column + 1 
    Sat = Cells(Rows.Count, "A").End(3).Row
 
    Application.ScreenUpdating = False
 
    For i = 1 To Sat
        Randomize
        Cells(i, Kol) = Rnd
    Next i
 
    Range(Cells(1, 1), Cells(Sat, Kol)).Sort Key1:=Cells(1, Kol)
    Columns(Kol).Delete
 
    Application.ScreenUpdating = True
 
End Sub

 

[Gorarr]

Necdet hocam tam istediğim gibi olmuş çok teşekkür ederim. Ellerinize sağlık. Saygılar selamlar...