fonksiyon ekleme

[Erdem Akdemir]

kodları herhangi birini çalıştırdıktan sonra abone no sütunun en altına gelip, bir boşluk bıraktıktan sonra "TOPLAM" yazmak ve sağındaki hücreye'de alttoplam fonksiyonunu eklemek istiyorum

YANLIŞ DOSYA KOYMUŞTUM, GÜNCELLEDİM

 

[Erdem Akdemir]

lütfen yardımlarınızı bekliyorum

 

[leumruk]

Kodların herhangi birini çalıştırdıktan sonra, demişsiniz; ama ben dosyanızda kod göremedim. Ayrıca, eklenmesini istediğiniz, fonksiyonu da yazarsanız memnun olurum.

 

[Erdem Akdemir]

makroyu kaydederken kişisel çalışma kitabına kaydetmişim ondan çıkmamış

sizi bulmuşken istediklerimi söyliyeyim

kodu çalıştırdıktan sonra abone no sütünun en sonuna inerek bir boşluk bırakarak "toplam" yazmak istiyorum ,sağındaki hücreye'de alttoplam fonksiyonunu eklemek istiyorum ondan sonra

işlem adı sütünundaki bütün ödeme tiplerini süzerek yazdırmak istiyorum ama sıfır olan değerleri yazdırmadan

 

[Erdem Akdemir]

arkadaşlar lütfen yardımlarınızı esirgemeyin

 

[leumruk]

Syn. kuvari,
Verileriniz sabit mi? Eksilme ya da artma oluyor mu? Dosyanızın çalışma mantığını açıklar mısınız? Eğer veriler sabitse farklı kod, değişkense farklı kod yazmak gerekiyor. Bu nedenle kesin bilgiler vermeniz gerekiyor.

 

[Erdem Akdemir]

Syn. kuvari,
Verileriniz sabit mi? Eksilme ya da artma oluyor mu? Dosyanızın çalışma mantığını açıklar mısınız? Eğer veriler sabitse farklı kod, değişkense farklı kod yazmak gerekiyor. Bu nedenle kesin bilgiler vermeniz gerekiyor.

veriler değişiyor, bazen 250 satır oluyor, bazende 1500 satır

işlem tiplerinden benim belirlediklerimi süzmesini ve süzdüklerini yazdırmasıda gerekli, hepsini süzüp yazmasın

 

[leumruk]

Sub ToplamEkle()
Sat = [a65536].End(3).Row + 2
Cells(Sat, "h") = ""
Cells(Sat, "g") = ""
Cells(Sat, "g") = "TOPLAM"
For i = 3 To [I65536].End(3).Row
Cells(Sat, "h") = Cells(Sat, "h") + Cells(i, "ı")
Next i
End Sub

Bu kodla İlk iki isteğinizi yapabilirsiniz. Yani "TOPLA" yazar ve yanına belirttiğiniz sütunu toplar. Ancak bu kodu veri kaydetme kodlarınıza uygun şekilde yerleştirmeniz gerekli.
Şu an 730'uncu satır dolu, mesela 731. satıra girişi ne ile yapıyorsunuz? Bu kodu sizin kodlarınıza uyarlamamız gerek. Açıklama istememin sebebi bu. Uyarlamayı benim yapmam için kodları görmem gerekli.
Listeleme konusunda bir fikrim yok. Önce ilk isteğinizi halledelim. Sonra ayrı bir başlıkta listelemeyi açıp, iyice açıklarsınız.

 

[Erdem Akdemir]

Sub ToplamEkle()
Sat = [a65536].End(3).Row + 2
Cells(Sat, "h") = ""
Cells(Sat, "g") = ""
Cells(Sat, "g") = "TOPLAM"
For i = 3 To [I65536].End(3).Row
Cells(Sat, "h") = Cells(Sat, "h") + Cells(i, "ı")
Next i
End Sub

Bu kodla İlk iki isteğinizi yapabilirsiniz. Yani "TOPLA" yazar ve yanına belirttiğiniz sütunu toplar. Ancak bu kodu veri kaydetme kodlarınıza uygun şekilde yerleştirmeniz gerekli.
Şu an 730'uncu satır dolu, mesela 731. satıra girişi ne ile yapıyorsunuz? Bu kodu sizin kodlarınıza uyarlamamız gerek. Açıklama istememin sebebi bu. Uyarlamayı benim yapmam için kodları görmem gerekli.
Listeleme konusunda bir fikrim yok. Önce ilk isteğinizi halledelim. Sonra ayrı bir başlıkta listelemeyi açıp, iyice açıklarsınız.

Sub Makro1()
Columns("J:M").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1:F1").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
Range("C2").Select
Selection.AutoFilter
With ActiveSheet.PageSetup

.LeftMargin = Application.InchesToPoints(0.15748031496063)
.RightMargin = Application.InchesToPoints(0.15748031496063)

.CenterHorizontally = True


End With
End Sub

bu kodu ben yazdım, sizin yazdığınızı ekleyince hiçbir işime yaramadı

benim istediğim yukardaki kod çalıştıktan sonra o rapordaki gereksiz yerler silinecek ve yazıcıdan çıktı alınacak hale gelecek tek istediğim

sütün sayısı sabit olacak ama satır sayısı devamlı değişecek

yukardaki kodu çalıştırdıktan sonra "e" sütünundaki en alt kısma gelecek ve bir boşluk bırakarak "toplam" yazacak, sağındaki hücrede'de alttoplam fonksiyonun olması gerekiyor, süzme işlemini kullanacağım için,

eğer yapabilirseniz işlem tiplerinin hepsini sırayla süzsün ve yazdırsın

hepsinin tekbir makro olması lazım

iyi çalışmalar

 

[leumruk]

Bu şekilde dener misiniz?

Sub Makro1()
Sat = [a65536].End(3).Row + 2
Cells(Sat, "f") = ""
Cells(Sat, "e") = ""

    Columns("J:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:F1").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
    Range("C2").Select
    Selection.AutoFilter
    With ActiveSheet.PageSetup
     
        .LeftMargin = Application.InchesToPoints(0.15748031496063)
        .RightMargin = Application.InchesToPoints(0.15748031496063)
   
        .CenterHorizontally = True
    End With
    
Cells(Sat, "e") = "TOPLAM"
Cells(Sat, "f").FormulaR1C1 = "=SUBTOTAL(9,R3C:R[-2]C)"
End Sub

 

[Erdem Akdemir]

Bu şekilde dener misiniz?

Sub Makro1()
Sat = [a65536].End(3).Row + 2
Cells(Sat, "f") = ""
Cells(Sat, "e") = ""

    Columns("J:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:F1").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
    Range("C2").Select
    Selection.AutoFilter
    With ActiveSheet.PageSetup
     
        .LeftMargin = Application.InchesToPoints(0.15748031496063)
        .RightMargin = Application.InchesToPoints(0.15748031496063)
   
        .CenterHorizontally = True
    End With
    
Cells(Sat, "e") = "TOPLAM"
Cells(Sat, "f").FormulaR1C1 = "=SUBTOTAL(9,R3C:R[-2]C)"
End Sub

sayın leumruk gecenin bu saatinde benimle ilgilendiğiniz için teşekkür ederim

sorunum çözüldü, sizi beklerken bende şöyle bir kod yazmıştım

SUBTOTAL(9,INDIRECT(""F""&ROW()-ROW()+3):INDIRECT(""F""&ROW()-1))

işlem tiplerini süzüp yazdırma konusunda yardımcı olabilir misiniz?

hepsini süzmek istemiyorum sadece istediklerimi onları kodun içine ben yazabilirim, tabi siz bitirdikten sonra

 

[leumruk]

Syn. kuvari veri süzme konusunda hiç çalışmadım;ama bu konuyu iyi bilen arkadaşlar vardı. Bugün yılbaşı olduğu için çoğu aktif değil, isterseniz yarın "veri süzme" başlığıyla yeniden konu açın. Aldığınız kodları elinizdeki kodun en altına yerleştirdiğinizde bir bütün olarak çalışacaktır.
Yardımcı olmayı çok isterdim; ama bu konuda sizden daha bilgili değilim.
İyi geceler.

 

[Erdem Akdemir]

sizede iyi geceler

zaten oldukça yardımcı oldunuz