liste Düzenle adlı makroyu kısaltma

[kurthan]

Arkadaşlar merhaba;
yazmız olduğum bir makro var ama bazı bölümleri kaydet yöntemi ile yaptım
özellikle kenarlık oluşturma bölümünü
bu bölümde kodlarda kısaltma yapılabilir mi?
birde kenarlık oluştururken ben burda aralık seçerek yaptım bunu döngü ile benim istediğim aralıkları yada en son satıra gelip ordan itibaren işlem yapmasını istiyorum
zira sayfa standart degil satır sayısı değişe biliyor.
ekli dosyada modul 1 kısmında kodları bulabilirsiniz.

 

[kurthan]

Dostlar yok mu bir yolu
bir gün bununla uğraştım boşa gitmemiş olcak ama daha kullanışlı olsun diye sizlerden yardım istedim.

 

[leumruk]

Merhaba,
Kontrol etme şansım olmadı. Sağlamasını siz yaparsınız...

Sub liste_düzenle()
With Cells
    .WrapText = False
    .UnMerge
    .Replace What:="KILOGRAM", Replacement:="KG"
    .Replace What:="ADET", Replacement:="AD"
    .Replace What:="LITRE", Replacement:="LT"
End With

Range("a:a, c:c, g:w").Delete shift:=xlUp
'Columns("c:c").EntireColumn.Cut
Columns("E:E").Insert shift:=xlToRight
Rows("1:2").Insert shift:=xlDown
Range("a2") = "Alt Grup"
Range("b2") = "Stok Malı"
Range("c2") = "Birim"
Range("d2") = "Bakiye"
Range("e2") = "Sayım"
Range("f2") = "Toplam"
Range("f1") = "=TODAY()"
Range("a2:f2").Font.Bold = True

    With Rows("3:999").Font
        .Name = "Arial Tur"
        .Size = 8
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("A3").Select
    Columns("A:A").Replace What:="* - ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Cells.EntireColumn.AutoFit
    With Range("A3:F" & [a65536].End(3).Row)
        .Borders.LineStyle = xlNone
        .Borders.Weight = xlHairline
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
    End With
    
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.17)
        .RightMargin = Application.InchesToPoints(0.17)
        .TopMargin = Application.InchesToPoints(1.56)
        .BottomMargin = Application.InchesToPoints(0.21)
        .HeaderMargin = Application.InchesToPoints(1.5)
        .FooterMargin = Application.InchesToPoints(0.18)
    End With
        Columns("E:E").ColumnWidth = 27
    ActiveSheet.PrintOut from:=1, copies:=1
End Sub

 

[kurthan]

mustafa bey merhaba
öncelikli olarak tşk.ler
kısaltmalar okey fakat
çerçeve dışındaki hücreler yanı iç çizgiler kesik kesik çizgi olcak örnekte olduğu gibi
birde satırlar değişti zaman son satıra kadar kenarlık koysun
ben baska bır rapor aldım denedım ama kenarlığı yarıya kadar yaptı

 

[leumruk]

Yukarıdaki kodu güncelledim. Yeniden deneyebilirsiniz.

 

[kurthan]

Mustafa hocam çok tşk.ler
şimdi güzel oldu