Sıralama makrosu

[Dede Korkut]

Sub gygoresiralama()
'
' gygoresiralama Makro
'
' Klavye Kısayolu: Ctrl+q
'
Range("C5921:G5929").Select
Range("G5929").Activate
ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Add Key:=Range( _
"G5922:G5929"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sayfa2").Sort
.SetRange Range("C5921:G5929")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
--------------------------------------------------------------

Selam.. Makrolara yeni başladım....

Yukarıdaki makro gördüğünüz üzere sıralamaya ait... ama ben excel dosyasında aşşağıya doğru iniyor ve farklı satırlarda sırlama yapıyorum.. Bu makroyu çalıştırdığımda hep aynı işlemi yapıyor yani C5921:G5929 arasını sıralıyor .. Ben ise hangi bölgeyi seçtiysem bu makor onu sıralasın istiyorum.Bu amaçla makroyu nasıl düzenleyebilirim?

mesela c6000:g6008 arasını sıralamak istediğimde aynı makroyla nasıl sıralayabilirim?

 

[hamitcan]

Örneği kendinize göre uyarlayın.

Sub Makro1()
Set tbl = ActiveCell.CurrentRegion
x = tbl.Offset(1, 0).Resize(1, _
    1).Address

    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range(x), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SetRange tbl
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Dede Korkut]

Örneği kendinize göre uyarlayın.

Sub Makro1()
Set tbl = ActiveCell.CurrentRegion
x = tbl.Offset(1, 0).Resize(1, _
    1).Address

    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range(x), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SetRange tbl
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Teşekkürler de bu herhalde 2 aylık çocuğa kepçeyle yemek yedirmek gibi birşey olur...

40 yıl uğraşsam C'den G ye kadar seçim yapacağım ve Gdeki veriye göre sıralayacağım şekle getiremem bu makroyu rica etsem siz yaparmısınız?

yani soldan sağa doğru 5 tane sütun alta doğru adedini şuanda bilmediğim kadar satır seçeceğim 5. sütundaki veriye göre sıralayacağım..

 

[halit3]

önce seçim yapacaksınız sonra bu makroyu çalıştıracaksınız.

bunu denermisiniz.

Sub sırala()
deg1 = ActiveWindow.Selection.Address
deg2 = ActiveWindow.Selection.Row
deg3 = ActiveWindow.Selection.Column
If deg3 <> "3" Then MsgBox "C sütununu seçmediniz": Exit Sub
son = Len(ActiveWindow.Selection.Address(False, False))
For i = 1 To son
If Mid(ActiveWindow.Selection.Address(False, False), i, 1) = ":" Then
hucre = Mid(ActiveWindow.Selection.Address(False, False), i + 1, son)
deg5 = ""
For j = 1 To Len(hucre)
sayi = Mid(hucre, j, 1)
If IsNumeric(sayi) <> True Then
deg5 = deg5 & sayi
End If
Next
End If
Next
If deg5 <> "G" Then MsgBox "G sütununu seçmediniz": Exit Sub
MsgBox ActiveWindow.Selection.Address(False, False)
Range(deg1).Sort Key1:=Range("G" & Val(deg2)), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

 

[hamitcan]

Sub Makro11()
    ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Add Key:=Range("g" & Selection.Row), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa2").Sort
        .SetRange Range(Selection.Address)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Dede Korkut]

Sayın halit işte bu makro çalıştı çok teşekkürler. Yanlız makro çalıştıktan sonra otomatik kaydediyor bir hata işleminde geri alma yapamıyorum...


Sayın Hamitcan size de teşekürler bu makroyu da deneyeceğim..

 

[halit3]

Sayın halit işte bu makro çalıştı çok teşekkürler. Yanlız makro çalıştıktan sonra otomatik kaydediyor bir hata işleminde geri alma yapamıyorum...


Sayın Hamitcan size de teşekürler bu makroyu da deneyeceğim..

çalıştırılan makroları geri alma seçeneği yok ancak başka bir sayfaya önceki durumunu kayıt eder sonra ihtiyaç olursa başka bir makro ile geri alınabilir.

 

[halit3]

ekli dosyadaki görsel resimli anlatım var kendin bunu yap ve aşağıdaki makroyuda kullan

Sub sırala2()
deg1 = ActiveWindow.Selection.Address
deg2 = ActiveWindow.Selection.Row
deg3 = ActiveWindow.Selection.Column
If deg3 <> "3" Then MsgBox "C sütununu seçmediniz": Exit Sub
son = Len(ActiveWindow.Selection.Address(False, False))
For i = 1 To son
If Mid(ActiveWindow.Selection.Address(False, False), i, 1) = ":" Then
hucre = Mid(ActiveWindow.Selection.Address(False, False), i + 1, son)
deg5 = ""
For j = 1 To Len(hucre)
sayi = Mid(hucre, j, 1)
If IsNumeric(sayi) <> True Then
deg5 = deg5 & sayi
End If
Next
End If
Next
If deg5 <> "G" Then MsgBox "G sütununu seçmediniz": Exit Sub
MsgBox "işlem doğru " & ActiveWindow.Selection.Address(False, False)
End Sub

 

[halit3]

size başka bir uygulama daha gönderiyorum.

açılışta kontrollerim diye bir menü oluşacaktır burada sırala excel menüsü bulunmaktadır işlemlerini buradanda yapabilirsin hatta yanlış bir uygulama yapılırsa geri alma durumuda var.

 

[Dede Korkut]

Emek vermişsiniz teşekkürler... Peki hazırladığınız makroyla geri dönüşümsüz olsa da C ve G arası seçimleri G ye göre sıralıyoruz... Peki aynı anda bu seçim içinde yer alan E sütunundaki verileri yukarıdan aşşağıya doğru artan biçimde sıralamak için

bu makroya

---------------------------------

Sub sırala()
deg1 = ActiveWindow.Selection.Address
deg2 = ActiveWindow.Selection.Row
deg3 = ActiveWindow.Selection.Column
If deg3 <> "3" Then MsgBox "C sütununu seçmediniz": Exit Sub
son = Len(ActiveWindow.Selection.Address(False, False))
For i = 1 To son
If Mid(ActiveWindow.Selection.Address(False, False), i, 1) = ":" Then
hucre = Mid(ActiveWindow.Selection.Address(False, False), i + 1, son)
deg5 = ""
For j = 1 To Len(hucre)
sayi = Mid(hucre, j, 1)
If IsNumeric(sayi) <> True Then
deg5 = deg5 & sayi
End If
Next
End If
Next
If deg5 <> "G" Then MsgBox "G sütununu seçmediniz": Exit Sub
MsgBox ActiveWindow.Selection.Address(False, False)
Range(deg1).Sort Key1:=Range("G" & Val(deg2)), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

------------------------------------------------------

nasıl bir ilave yapmamız gerekir?

 

[halit3]

9 numaralı mesajdaki dosyayı görmediniz herhalde
yeniden buraya ekliyorum açılışta sıralama menüsü gelecek sayfadan belirliyeceğin bölgeyi sonradan sıralama münüsünü tıkla bu uygulamada geri alma var.