• DİKKAT

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

Banka hesap hareketleri düzenleme

onder_09

Altın Üye
Katılım
17 Mart 2017
Mesajlar
212
Excel Vers. ve Dili
2016 türkçe
Kod:
Sub Makro1()
'
' Makro1 Makro
'

'
    Range("A1:E14").Select
    Range("C6").Activate
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.UnMerge
    With Selection.Font
        .Name = "Calibri"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A3:C3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Columns("C:C").Select
    Selection.NumberFormat = "#,##0.00 $"
    Range("A1:C14").Select
    Range("B5").Activate
    Selection.Rows.AutoFit
    Selection.Columns.AutoFit
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Hesap Hareketleri - 2026-04-04T").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Hesap Hareketleri - 2026-04-04T").Sort.SortFields. _
        Add2 Key:=Range("A4:A14"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Hesap Hareketleri - 2026-04-04T").Sort
        .SetRange Range("A5:C14")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B9").Select
End Sub


Merhaba makro kaydet olarak bu makroyu hazırladım ancak satır sayısını 14 olarak seçiyor ben bu sayıyı sınırsız yapmak istiyorum ve a sütununu para birimi olarak değilde kısa tarih olarak ayarlayıp tarih sırasına göre sıralamasını istiyorum kodda nereleri düzenlemem gerekiyor yardımcı olur musunuz? Bankadan indirdiğim Örnek dosyayıda ekliyorum.
 

Ekli dosyalar

Kod:
Range("a1:e" & Range("a1").End(xlDown).Row).Select
' tüm veriyi seçmek için
Kod:
Range("a5:e" & Range("a1").End(xlDown).Row).Sort key1:=[a5]
'tarihe göre sıralama yapmak için.
 
Kod:
Sub BankaDuzenle()
Dim sonSatir As Long
    sonSatir = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A5:A" & sonSatir).NumberFormat = "dd.mm.yyyy"
        Range("A5:A" & sonSatir).TextToColumns Destination:=Range("A5"), DataType:=xlDelimited, FieldInfo:=Array(1, xlDMYFormat) ' 5. satırı başlık kabul ederek tarihe göre sırala
    Range("A5:E" & sonSatir).Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlYes
End Sub

Kontrol eder misiniz.
 
Geri
Üst