Tarihlerde Sıralama

[iplikci_80]

Arkadaşlar yapmak istediğim şey EK'te sunduğum örnekteki makroda bozulma olmadan A sütunundaki tarihleri küçükten büyüğe sıralanmasını sağlayacak şekilde düzelteme yapmak istiyorum, çok denedim fakat başaramadım yardımlarınıza ihtiyacım var. Herkese çok teşekkür ederim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Sirala()
    
    Dim i As Long
    
    i = Cells(Rows.Count, "B").End(3).Row
    
    If i > 2 Then Range("B2:J" & i).Sort Key1:=[B2]
    
End Sub

 

[iplikci_80]

Necdet Bey öncelikle ayırdığınız zaman ve emek için teşekkür eder. Aşağıdaki şekilde yapmaya çalıştım fakat başaramadım lütfen yardımcı olurmusunuz.



Sub Sirala()

Dim i As Long

i = Cells(Rows.Count, "B").End(3).Row

If i > 2 Then Range("B2:J" & i).Sort Key1:=[B2]

End Sub
Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim evn As Range
If Target.Column = 10 Then
Set Satir = Range(Cells(Target.Row, "a"), Cells(Target.Row, "k"))
Set evn = Range(Cells(Target.Row, "a"), Cells(Target.Row, "k"))
Select Case UCase(Target)
Case Asc("1") To Asc("10")
Case Else
MsgBox "D İ K K A T, ARŞİV'e A K T A R I Y O R U M"
Target.EntireRow.Copy Sayfa2.Range("a" & Sayfa2.[b65536].End(3).Row + 1)
Target.EntireRow.Delete
Worksheets("ARŞİV").Select

End Select
End If
End Sub

 

[Necdet]

Ne yapmak istediğinizi anlamakta güçlük çekiyorum.

Modul1 in içine gönderdiğim kodları kopyalayınız.
Modul1 içindeki sayfa ile ilgili kodları siliniz.

Sayfa içinde değişiklik olduğunda otomatik sıralama yaptırmak isterseniz -ki pek mantıklı değil o zaman sayfa kodlarından verdiğim proceduru çağırabilirsiniz.

 

[iplikci_80]

Merhabalar
Yapmak istediğim olay B sütununa girilen tarihleri küçükten büyüğe sıralatmak ve ikinci olarak J sütununa tarih değeri girildiğinde o satırı silip ARŞİV sayfasına aktarılmasını sağlamak.

 

[Ömer]

Merhaba,

Kodları bu şekilde değiştirin. Yeşil olan satırları pasif yaptım. Ayrıca kırmızı satırları ilave ettim.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim evn As Range[COLOR=red], i As Long[/COLOR]
If Target.Column = 10 Then
Set Satir = Range(Cells(Target.Row, "a"), Cells(Target.Row, "k"))
Set evn = Range(Cells(Target.Row, "a"), Cells(Target.Row, "k"))
Select Case UCase(Target)
Case Asc("1") To Asc("10")
Case Else
MsgBox "D İ K K A T, ARŞİV'e A K T A R I Y O R U M"
Target.EntireRow.Copy Sayfa2.Range("a" & Sayfa2.[b65536].End(3).Row + 1)
[COLOR=teal]'Target.EntireRow.Delete[/COLOR]
[COLOR=teal]'Worksheets("ARŞİV").Select[/COLOR]
End Select
[COLOR=red]i = Cells(Rows.Count, "B").End(3).Row[/COLOR]
[COLOR=red]If i > 2 Then Range("B2:J" & i).Sort Key1:=[B2][/COLOR]
End If
End Sub

 

[iplikci_80]

Sayın Ömer Merhabalar. Öncelikle ilginiz için çok teşekkür ederim.Dediğiniz gibi yapmaya çalıştım ama başarılı olmadım. Lütfen EK 'te ki örneğe uygulayabilir misiniz.

 

[Ömer]

Örnek üzerinde eklememe gerek yok. Eski kodun yerine bu kodu yazmanız gerekir. Bende eklersem aynı şeyi yapacaktım.

Olmayan nedir açıklarsanız ona göre bakmaya çalışayım.

 

[iplikci_80]

B sütunundaki tarihleri küçükten büyüğe sıralamasını yapmıyor.

 

[Ömer]

J sütununa veriyi girdikten sonra, veri önce arşiv sayfasına gider sonra MART sayfasında istediğiniz sıralama olur.

Şimdi denedim sonuc olumlu.

Önce eklediğiniz dosyadaki kodları verdiklerimle değiştirin. Daha sonra B6 hücresine 23.03.2012 yazın ve son olarak, J6 hücresine bir değer girin (653 gibi) ve entera basın.
Bu işlemden sonra arşivlendiğine dair mesaj kutusu cıkar, tamam dedikten sonra istediğiniz sıralamanın sayfa üzerinde yapıldığını görebilirsiniz.

23.03.2012 değeri B6 da değil sırası gereği B4 hücresine kayar.

 

[iplikci_80]

Benim Yaptırmak istediğim öncelikle B sütunun küçükten büyüğe sıralanmasını sağlamak. Yani B6 hücresine 23.03.2012 yazdıktan sonra küçükten büyüğe sıralanmasını sağladıktan sonra, J6 hücresine bir değer gireceğim ve silip arşive aktarılmasını sağlamak.

 

[Ömer]

J sütununa girilen kodlarda sorun olmadığın düşünerek sadece B ye girilen verilerde sıralamayı ekledim. İlave kırmızı ile işaretli.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim evn As Range[COLOR=red], i As Long[/COLOR]
[COLOR=red]If Target.Column = 2 Then
i = Cells(Rows.Count, "B").End(3).Row
If i > 2 Then Range("B2:J" & i).Sort Key1:=[B2]
End If[/COLOR]
If Target.Column = 10 Then
Set Satir = Range(Cells(Target.Row, "a"), Cells(Target.Row, "k"))
Set evn = Range(Cells(Target.Row, "a"), Cells(Target.Row, "k"))
Select Case UCase(Target)
Case Asc("1") To Asc("10")
Case Else
MsgBox "D İ K K A T, ARŞİV'e A K T A R I Y O R U M"
Target.EntireRow.Copy Sayfa2.Range("a" & Sayfa2.[b65536].End(3).Row + 1)
Target.EntireRow.Delete
Worksheets("ARŞİV").Select
End Select
End If
End Sub

İstediğiniz bu mu?

 

[iplikci_80]

Ayırdığınız zaman ve harcadığınız emek için teşekkürler.