• DİKKAT

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

Alt Toplam Alma

Aşağıdaki şekilde dener misiniz?
Kod: 
Sub Add_Totals2()
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
         NumRange.Offset(0, -9).Resize(, 10).Select: kenarlik
         NumRange.Offset(0, 1).Resize(, 5).Select: kenarlik2
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")) = "=SUM(" & SumAddr & ")"
    Next NumRange
End Sub
Sub kenarlik()
    With Selection.Borders
        .LineStyle = xlContinuous
        .Color = -11489280
        .TintAndShade = 0
        .Weight = xlThick
    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
End Sub
Sub kenarlik2()
    With Selection.Borders
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThick
    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
End Sub
 
Sn. Hamitcan kodlar icin teşekkür ederim...Çok işime yaradı...Tekrar tşk.ler...
 
hocam
Kod: 
'        .TintAndShade = 0
satırında hata veriyordu bende kod da kapadım ne anlama geliyor acaba
 
Tam incelemedim ama gölgelendirme ve renk tonları ile ilgili olmalı. Kodun çalışmasını etkileyeceğini zannetmiyorum.
 
hocam .ok zahmet verdim ama şu nasıl olmalı peki
Kod: 
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")) = _
"=SUM(" & SumAddr & ")"
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "H")) = _
2.04
         'Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "I")) = _
? [color="red"] G (toplam aldırılan satır) * H (toplam aldırılan satır) [/color]

yani I (toplam aldırılan satır) = G (toplam aldırılan satır) * H (toplam aldırılan satır)
formulü nasıl girilmeli

Kod: 
Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "I")) = _
Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")) *_
Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "H"))

şeklinde hücrede değeri görüyorum ama bana fomüllüsü lazım g3*h3 gibi
 
Son düzenleme:
Farklı alanların toplamını aldırıp sonuçları, çarpmak mı istiyorsunuz?
 
evet G sütununa boş satırlarla ayrılmış aralıkların alttoplamını aldık
o toplam aldığımız yerin yanına (h sütunu) ben birim fiyatı yazdım
I sütununda ikisinin çarpımını almak istiyorum nitekim alıyorumda ancak hücrede değer yerine formül görmek istiyorum.
 
Ayrıca
Kod: 
[B]'Range("I" & snst + 2) = WorksheetFunction.Sum(Range("I3:I" & snst))[/B]
yukarıdaki satırı 
[Color="red"][B]Range("I" & snst + 2) = "=Sum("I3:I" & snst )"[/B][/Color]
nasıl bu şekilde düzenleriz?
 
Kod: 
Range("I" & snst + 2) = "=Sum(" & "I3:I" & snst & " )"
şeklinde deneyin.
 
hamitcan' Alıntı:
Kod: 
Range("I" & snst + 2) = "=Sum(" & "I3:I" & snst & " )"
şeklinde deneyin.
Genişletmek için tıkla ...

Hocam Teşekkür ederim. Arada kaynamış bir de bu sorum vardı;

hsayar' Alıntı:
hocam .ok zahmet verdim ama şu nasıl olmalı peki
Kod: 
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")) = _
"=SUM(" & SumAddr & ")"
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "H")) = _
2.04
         'Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "I")) = _
? [color="red"] G (toplam aldırılan satır) * H (toplam aldırılan satır) [/color]

yani I (toplam aldırılan satır) = G (toplam aldırılan satır) * H (toplam aldırılan satır)
formulü nasıl girilmeli

Kod: 
Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "I")) = _
Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")) *_
Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "H"))
Genişletmek için tıkla ...

yukarıdaki ikinci kodlar ile
hücrede değeri görüyorum ama bana fomüllüsü lazım g3*h3 gibi
 
Son düzenleme:
Makro kullanmadan, Excel formülleri ile yapmayı denediniz mi?
 
Hocam ozaman I sütununa g ve h boş değilse çarp demek lazım, ama ben düzen bozulmasın hazır toplam almışken hepsi bir arada çıksın diyorum, şunun için birim fiyatımız 2,04 (30.Mesajdan anlaşılacağı üzere ama o adama biz fark vereceğiz nadiren olan olaydır.) 2,50 olacak sadece H deki birim fiyatı değiştirince çarpım da otomatik değişecek toplam zaten değişiyor...

eğer olmaz mümkün değil derseniz Hemen hücrede g ve h nin ilgil isatırları çarptırılabilir... ama otomatik olsa fenda olmaz hani
 
Kodu aşağıdaki şekilde değiştirin.
Kod: 
Sub Add_Totals2()
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
         NumRange.Offset(0, -9).Resize(, 10).Select: kenarlik
         NumRange.Offset(0, 1).Resize(, 5).Select: kenarlik2
         TOPLAM = Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")
         Range(TOPLAM) = "=SUM(" & SumAddr & ")"
         Range(TOPLAM).Offset(0, 2) = "=RC[-2]*RC[-1]"
    Next NumRange
End Sub
 
Kod: 
Sub Add_Totals2()
Application.ScreenUpdating = False
Call KenarlikYok
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
         NumRange.Offset(0, -9).Resize(, 10).Select: kenarlik
         NumRange.Offset(0, 1).Resize(, 5).Select: kenarlik2
         TOPLAM = Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")
         Range(TOPLAM) = "=SUM(" & SumAddr & ")"
         Range(TOPLAM).Offset(0, 1) = 2.04
         Range(TOPLAM).Offset(0, 2) = "=RC[-2]*RC[-1]"
    Next NumRange
Call GenelToplam
Range("a1").Select
Application.ScreenUpdating = True
End Sub

teşekkür ederim hocam bu şekilde çok güzel oldu, saygılar sunarım.

Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")

birde bu satırları açıklarsanız çok sevinirim... bir şeyleri birşeylerle değiştiriyor ama tam anlamadım
 
1-NumRange.Offset(0, 3).Address(False, False)-->Göreceli aralık ("M3:M9" gibi)
2-Split(NumRange.Offset(0, 3).Address(False, False), ":")(0)--> İlk parçayı bulmak için(M3 gibi)
3-Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")--> "M" harfini "G" ile değiştir. ("M3") hücresini ("G3")haline dönüştürür.
 
teşekkür ederim hocam .... şimdi tam anlamıyla kavradım
 
Merhaba Sn Hocam Yine ben :)

Kod: 
Sub AraToplam_Ana()
    For Each NumRange In Range("C6:C200").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 7).Address(False, False)
         Range(Replace(Split(NumRange.Offset(-1, 8).Address( _
         False, False), ":")(0), "C", "I")) = "=SUM(" & SumAddr & ")"
    Next NumRange
End Sub

yukarıdaki kodlar ile ara toplmaları almam gerekiyor ve Tablonun biçimin bozduktan sonra gayet güzel çalışıyor.

Amacımı anlatayım

C sütununda boş satırla ayrılmış veri aralığını tespit edip, (c7:c24) gibi
o aralığı J sütunu olarak değiştirmek ve, (J7:J24) gibi
aralığn tespit edildiği bir üst satın K sütununa [K6= TOPLA(J7:J24)]
gibi toplamını almak...
yukardaki kodlar bu işi yapıyor fakat acımasız bir durum var

Basamaklandırlmış tablo şeklinde özet geliyor bu sayfaya ve
Anabaşlık B:H aralığında
AltBaşlık C:H aralığında
olmak üzere birleşik ve dolayısıyla kodlar h nin
7 sütun sonrasına odaklanıp
8 sütun sonrası bir satır üstüne odaklanıp toplam alıyor ve yanlış sonuç dönüyor. öneriniz nedir.
 
Son düzenleme:
Kod: 
[B]Sub AraToplam_Ana()
1    For Each NumRange In Range("C6:H200").SpecialCells(xlCellTypeConstants, 23).Areas
2         SumAddr = NumRange.Offset(0, 7).Address(False, False)
3         SumAddr = Replace(SumAddr, "O", "J", 1)
4         Range(Replace(Split(NumRange.Offset(-1, 8).Address(False, False), ":")(0), "C", "J")) = "=SUM(" & SumAddr & ")"
5    Next NumRange
End Sub[/B]

verdiğim geçici rahatsızlıktan dolayı özür dilerim...
çözüm

Anlatayım öğrenmek isteyen arkadaşlar olabilir.
1 c6:h200 aralığında boşluklarla ayrılmış olan bulunması için föngü başlatıldı
2 toplanacak aralığın aynı satırda 7 sütun ilerde olduğunu söyledik
3 birleşmiş hücre olduğu için sonucu Jx:Oy diye döndürdü saçamalama sen O yuda J yap dedik.
4 toplama işleminin 1 satır üste ve 8 sütun ilerideki hücrede yap dedik ve hücrede formül gözüksün diye toplam formülünü yazdık.
5 Başka boşlukla ayrılmış hücre varmı kontrol et bakalım diye 1. satıra gönderdik.

1 ve 4. satırların ayrıntılı açıklmasını tam bilmiyorum.
 
Son düzenleme:
hamitcan' Alıntı:
1-NumRange.Offset(0, 3).Address(False, False)-->Göreceli aralık ("M3:M9" gibi)
2-Split(NumRange.Offset(0, 3).Address(False, False), ":")(0)--> İlk parçayı bulmak için(M3 gibi)
3-Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")--> "M" harfini "G" ile değiştir. ("M3") hücresini ("G3")haline dönüştürür.
Genişletmek için tıkla ...


Günaydın

yukarıdaki açıklmalara göre
1) Göreceli aralık ("M3:M9" gibi) ise
2) İkinci parçayı kodda nasıl buluruz yani M9 u
3) Address(False, False) de yer alan falselerin işlevi nedir?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst