ahmetmis
Altın Üye
- Katılım
- 17 Kasım 2004
- Mesajlar
- 78
- Excel Vers. ve Dili
- Excel 2019
- Altın Üyelik Bitiş Tarihi
- 04-05-2026
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
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