Çözüldü Makronun kendiliğinden sıralama yapabilmesi

Katılım
12 Aralık 2018
Mesajlar
25
Excel Vers. ve Dili
32 Bit 2016 Türkçe
Ekteki belgemde aşağıdaki işlemi yapan bir makro koduna ihtiyacım var.

C3: D17 arasındaki verileri C3:C17 sütunundaki değerleri baz alarak küçükten büyüğe makro ile sıralamak istiyorum.
Makro bir butonla değil kendi kendine bu sıralamayı yapsa çok iyi olur. Diğer deyişle C sütununa değer yazdıkça ilgili veri sırasına kendiliğinden gitsin.
Teşekkürler.
https://we.tl/t-zVnMAGeUh1
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Merhaba.

Alt taraftan uygulamanın yapılacağı sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
açılacak VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırın.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C3:C17]) Is Nothing Then Exit Sub
[C3:D17].Sort [C2], 1
End Sub
 
Son düzenleme:

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Alternatif olsun.
Sayfa adını sağ tıklatın "Kod Görüntüle" seçin açılan sayfaya aşağıdaki kodları yapıştırın.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SatirSay As Long
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    SatirSay = Cells(Rows.Count, "C").End(3).Row
    With ActiveSheet.Sort
        .SortFields.Add Key:=Range("C3:C" & SatirSay), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("B3:D" & SatirSay) ' Eğer sutunlar daha fazla olacaksa bu satırsaki "D" yi değiştirebilirsiniz.
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
 

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,581
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Merhaba,
Ömer Hocanın kodunda 1 i 2 yapınız
Dalgalıkur Hocanın kodunda Order:=xlAscending ifadesini Order:=xlDescending yapınız
İyi çalışmalar
 

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,581
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Muhterem Hocalarım,
Ben de araya bir soru atayım, burada önce D sütundaki hücreyi doldurup sonra C sütundaki hücreyi doldurursanız birlikte sıraya giriyor. Yoksa D sütunundaki hücre boşta olsa hepsi C sütununa göre sıraya giriyor.
Atlamayı engellemek için C yi ve D yi doldurduktan sonra entere basıp aşağı geçtiğinde tetiklemenin bir yolu var mıdır?
Saygılarımla
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe

If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub

buradaki "C:C" yi "D:D" yaparsanız D sutünunda bir değişiklik olduğunda tetiklenir.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Ben ise şöyle düşündüm.
Boş olan hücre hangisiyse (C veya D sütununda) o hücre seçili hale gelir.
İkiside doluysa sıralama yapılır.
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C3:D17]) Is Nothing Then Exit Sub
dolu = WorksheetFunction.CountBlank(Range("C" & Target.Row & ":D" & Target.Row)) Mod 2
If dolu = 0 Then [C3:D17].Sort [C2], 1
If Cells(Target.Row, "C") = "" Then Cells(Target.Row, "C").Activate
If Cells(Target.Row, "D") = "" Then Cells(Target.Row, "D").Activate
End Sub
 
Katılım
12 Aralık 2018
Mesajlar
25
Excel Vers. ve Dili
32 Bit 2016 Türkçe
Tevfik_Kursun kardeşim
5. mesaj: Dalgalıkur Hocanın kodunda Order:=xlAscending ifadesini Order:=xlDescending yapınız
Burayı yapamadım veya olmuyor.
 

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,581
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Sayfanın içinde arkadaşım.
Sayfa3 yazısının üzerine mouse ile gelip sağ tuş yapın Kod Görüntüle sekmesini tıklayın
karşınıza çıkacak
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SatirSay As Long
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    SatirSay = Cells(Rows.Count, "C").End(3).Row
    With ActiveSheet.Sort
        .SortFields.Add Key:=Range("C3:C" & SatirSay), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange Range("C3:D" & SatirSay) ' Eğer sutunlar daha fazla olacaksa bu satırsaki "D" yi değiştirebilirsiniz.
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
iyi çalışmalar
 
Katılım
12 Aralık 2018
Mesajlar
25
Excel Vers. ve Dili
32 Bit 2016 Türkçe
Üyeliğim olmadığından dosyayı indirememiştim.
Teşekkür ederim.
 
Üst