Makro tarihe göre sıralama yapamıyorum

[ahmetmis]

Aşağıdaki gibi verileri çeken bir makrom var. Sonucunda tarihler karışık olarak çıkıyor. Tarihleri küçükten büyüğe sıralı olsun istiyorum. Mümkünmüdür?

Sonuç bu şekilde gerçekleşiyor. hhttps://hizliresim.com/n2dby67 (resim eklemesi başarısız olduğu için link ekledim)


Sub Listele()

Dim s1 As Worksheet, Ilce As String, Alan As String

Set s1 = Sheets("Detay Bilgiler")
Set s2 = Sheets("Tamamlanan")
Application.ScreenUpdating = False
son = s2.Range("A" & Rows.Count).End(xlUp).Row
If son < 2 Then Exit Sub

s1.Range("A13:N" & Rows.Count).ClearContents
s1.Range("A13:N" & Rows.Count).ClearFormats

Ilce = UCase(Replace(Replace(VBA.Trim(s1.[E2]), "ı", "I"), "i", "İ"))
Alan = UCase(Replace(Replace(VBA.Trim(s1.[E3]), "ı", "I"), "i", "İ"))

a = s2.Range("A1:O" & son).Value

ReDim b(1 To UBound(a), 1 To 13)

For i = 2 To UBound(a)
p1 = UCase(Replace(Replace(VBA.Trim(a(i, 1)), "ı", "I"), "i", "İ"))
p2 = UCase(Replace(Replace(VBA.Trim(a(i, 4)), "ı", "I"), "i", "İ"))
If p1 = Ilce And p2 = Alan Then
say = say + 1
b(say, 1) = say
b(say, 2) = a(i, 3)
b(say, 9) = a(i, 5)
b(say, 10) = a(i, 8)
b(say, 13) = a(i, 7)

topla = topla + a(i, 7)
s1.Range("B" & say + 12).Resize(, 7).Merge
s1.Range("I" & say + 12).Resize(, 1).Merge
s1.Range("M" & say + 12).Resize(, 2).Merge
s1.Range("J" & say + 12).Resize(, 3).Merge
End If
Next i

If say > 0 Then

With s1.Range("B13").Offset(say).Resize(, 8)
.Merge
.Borders.Color = rgbLightGrey
.Value = "TOPLAM"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
End With

With s1.Range("M13").Offset(say).Resize(, 2)

.Merge
.Borders.Color = rgbLightGrey
.Value = topla
.HorizontalAlignment = xlRight
.NumberFormat = "#,##0 TL"
.RowHeight = 20
.Font.Bold = True
.VerticalAlignment = xlCenter

End With

With s1.Range("J13").Offset(say).Resize(, 3)

.Merge
.Borders.Color = rgbLightGrey

.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.RowHeight = 20
.Font.Bold = True


End With

s1.[J13].Resize(say).Select: Selection.HorizontalAlignment = xlLeft: Selection.VerticalAlignment = xlCenter
s1.[M13].Resize(say).NumberFormat = "#,##0 TL"
s1.[I13].Resize(say).Select: Selection.HorizontalAlignment = xlRight: Selection.HorizontalAlignment = xlCenter
s1.[A13].Resize(say, 13).Font.Size = 10
s1.[A13].Resize(say + 1, 13).Font.Color = rgbGray
s1.[A13].Resize(say, 13) = b
s1.[A13].Resize(say, 14).Borders.Color = rgbLightGrey: Selection.HorizontalAlignment = xlCenter: Selection.VerticalAlignment = xlCenter
' MsgBox "Veriler Bulundu...", vbInformation
' Else
' MsgBox "Yazdırılack veri bulunamadı...", vbCritical
End If
Application.ScreenUpdating = True

End Sub

 

[dEdE]

Merhaba,
Mevcut kodunuzdaki " Application.ScreenUpdating = True" satırından önce aşağıdaki kodu ekleyerek dener misiniz?

    ss = Cells(Rows.Count, "A").End(3).Row
    Range("A2:N" & ss).Sort Key1:=[I1], Order1:=1

 

[ahmetmis]

Merhaba,
Mevcut kodunuzdaki " Application.ScreenUpdating = True" satırından önce aşağıdaki kodu ekleyerek dener misiniz?

    ss = Cells(Rows.Count, "A").End(3).Row
    Range("A2:N" & ss).Sort Key1:=[I1], Order1:=1

https://hizliresim.com/mdmx6ab yine hata verdi maalesef

 

[dEdE]

Merhaba,
Birleştirilmiş hücreler genellikle sorun yaratır.
Dosya paylaşım sitelerinden biri ile örnek dosya paylaşırsanız çözüm daha kolay olur.

Send Large Files - Any Size - Up To 5 GB Free - Filemail

Send large files of any size fast. Share files up to 5 GB free with no account required. Trusted on all platforms for secure file transfers and sharing.

www.filemail.com

Büyük Dosyalar Gönderme - Dosya Paylaşımı - TransferNow

Transfer başına 250 GB'a kadar büyük dosyaları göndermek ve paylaşmak için en kolay, en hızlı ve en güvenli ücretsiz dosya aktarım çözümü. Kayıt gerekmez.

www.transfernow.net

Dosya Upload - Dosya Yükle indir

Ücretsiz olarak dosya upload edebileceğiniz dosya yükleme sitesi. Hızlı dosya yükle ve paylaş.

www.dosyaupload.com

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[dEdE]

Sorun birleştirilmiş hücrelerde.
Bu haliyle sıralama yapmak mümkün değil gibi görünüyor.
İlgili verileri başka bir sayfaya aktarıp yukarıda verdiğim kodlar ile orada sıralama yapılabilir. Bu durumda Kodun "Range("A2:N" & ss).Sort Key1:=[I1], Order1:=1" satırındaki A2:N ifadesindeki N harfi M olarak değiştirilmeli.

 

[ahmetmis]

Sorun birleştirilmiş hücrelerde.
Bu haliyle sıralama yapmak mümkün değil gibi görünüyor.
İlgili verileri başka bir sayfaya aktarıp yukarıda verdiğim kodlar ile orada sıralama yapılabilir. Bu durumda Kodun "Range("A2:N" & ss).Sort Key1:=[I1], Order1:=1" satırındaki A2:N ifadesindeki N harfi M olarak değiştirilmeli.

çok teşekkür ederim hocam