Günlük sıra değişikliği

[SnakErdem]

Merhaba, iyi forumlar arkadaşlar.

6u0cset.jpeg

ff

www.hizliresim.com

Fotoğrafta gözüktüğü gibi işler ve isimler var benim yapmak istediğim isimlerin günlük değişmesi. Mesela birinci sıradaki adam bir sonraki gün ikinci sırada olması lazım onuncu sıradaki kişinin ise birinci sırada olması lazım.Ve bu işlemler haftanın her günü değişmeli şimdiden teşekkür ederim.

 

[Muzaffer Ali]

Merhaba.

Sub Sirala()
    Dim Say As Long
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A2") = 2
    Range("A3:A" & Say).Formula = "=A2 +1"
    Range("A3:A" & Say).Value = Range("A3:A" & Say).Value
    Range("A" & Say) = 1
   
    With ActiveSheet.Sort
        .SortFields.Add2 Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A:C")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Sirala2()
    Dim Say As Long
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & Say & ":C" & Say).Cut
    Selection.Insert Shift:=xlDown
    Range("A2:A" & Say).Formula = "=row(A2)-1"
    Range("A3:A" & Say).Value = Range("A3:A" & Say).Value
End Sub

 

[SnakErdem]

Merhaba.

Sub Sirala()
    Dim Say As Long
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A2") = 2
    Range("A3:A" & Say).Formula = "=A2 +1"
    Range("A3:A" & Say).Value = Range("A3:A" & Say).Value
    Range("A" & Say) = 1
   
    With ActiveSheet.Sort
        .SortFields.Add2 Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A:C")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Çok teşekkür ederim Muzaffer bey.

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.