• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

B

Beşir TÜRK

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
 
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:
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
 
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
 
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
 
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.
 
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
 
Tevfik_Kursun kardeşim
5. mesaj: Dalgalıkur Hocanın kodunda Order:=xlAscending ifadesini Order:=xlDescending yapınız
Burayı yapamadım veya olmuyor.
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst