Alt Toplam Alma

hamitcan · 29 Kasım 2007

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

sakoz · 29 Kasım 2007

Sn. Hamitcan kodlar icin teşekkür ederim...Çok işime yaradı...Tekrar tşk.ler...

hsayar · 29 Kasım 2007

hocam

Kod:

'        .TintAndShade = 0

satırında hata veriyordu bende kod da kapadım ne anlama geliyor acaba

hamitcan · 29 Kasım 2007

Tam incelemedim ama gölgelendirme ve renk tonları ile ilgili olmalı. Kodun çalışmasını etkileyeceğini zannetmiyorum.

hsayar · 29 Kasım 2007

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&#305;r&#305;lan sat&#305;r) * H (toplam ald&#305;r&#305;lan sat&#305;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

hamitcan · 29 Kasım 2007

Farklı alanların toplamını aldırıp sonuçları, çarpmak mı istiyorsunuz?

hsayar · 29 Kasım 2007

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.

hsayar · 29 Kasım 2007

Ayrıca

Kod:

[B]'Range("I" & snst + 2) = WorksheetFunction.Sum(Range("I3:I" & snst))[/B]
yukar&#305;daki sat&#305;r&#305; 
[Color="red"][B]Range("I" & snst + 2) = "=Sum("I3:I" & snst )"[/B][/Color]
nas&#305;l bu &#351;ekilde d&#252;zenleriz?

hamitcan · 30 Kasım 2007

Kod:

Range("I" & snst + 2) = "=Sum(" & "I3:I" & snst & " )"

şeklinde deneyin.

hsayar · 30 Kasım 2007

hamitcan' Alıntı:
Kod:

Range("I" & snst + 2) = "=Sum(" & "I3:I" & snst & " )"

şeklinde deneyin.

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&#305;r&#305;lan sat&#305;r) * H (toplam ald&#305;r&#305;lan sat&#305;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"))

yukarıdaki ikinci kodlar ile
hücrede değeri görüyorum ama bana fomüllüsü lazım g3*h3 gibi

hsayar · 30 Kasım 2007

güncel....

hamitcan · 30 Kasım 2007

Makro kullanmadan, Excel formülleri ile yapmayı denediniz mi?

hsayar · 30 Kasım 2007

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

hamitcan · 30 Kasım 2007

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

hsayar · 30 Kasım 2007

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

hamitcan · 3 Aralık 2007

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.

hsayar · 3 Aralık 2007

teşekkür ederim hocam .... şimdi tam anlamıyla kavradım

hsayar · 20 Şubat 2008

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.

hsayar · 20 Şubat 2008

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.

hsayar · 22 Şubat 2008

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.

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?

Alt Toplam Alma

hamitcan

Uzman

sakoz

hsayar

hamitcan

Uzman

hsayar

hamitcan

Uzman

hsayar

hsayar

hamitcan

Uzman

hsayar

hsayar

hamitcan

Uzman

hsayar

hamitcan

Uzman

hsayar

hamitcan

Uzman

hsayar

hsayar

hsayar

hsayar