• DİKKAT

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

fonksiyon ekleme

Erdem Akdemir

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,677
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
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
 

Ekli dosyalar

Son düzenleme:
lütfen yardımlarınızı bekliyorum
 
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.
 
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
 

Ekli dosyalar

arkadaşlar lütfen yardımlarınızı esirgemeyin
 
Son düzenleme:
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.
 
leumruk' Alıntı:
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.
Genişletmek için tıkla ...

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
 
Kod: 
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.
 
leumruk' Alıntı:
Kod: 
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.
Genişletmek için tıkla ...


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
 
Bu şekilde dener misiniz?
Kod: 
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
 
Son düzenleme:
leumruk' Alıntı:
Bu şekilde dener misiniz?
Kod: 
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
Genişletmek için tıkla ...

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
 
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.
 
sizede iyi geceler

zaten oldukça yardımcı oldunuz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst