Alt Toplam Alma

[donjuan1905]

Merhabalar
Elimizde şu şekilde bir veri var. Ve yapmak istediğim her bir parçanın alt toplamını almak.

----A--
----5-----
----3-----
----1-----
----------
----2-----
----3-----
----1-----
----------
----4-----
----3-----
----------
----8-----
----------
Bu tablonun, makro döndükten sonra olmasını istediğim hali şu:
----A--
----5-----
----3-----
----1-----
----9-----
----2-----
----3-----
----1-----
----6-----
----4-----
----3-----
----7-----
----8-----
----8-----

Herbir parçanın alt toplamını alıp, bold yapan program. Yardımlarınızı bekliyorum

 

[Necdet]

Merhaba,

• A sütununu seçiniz
• F5
• Özel
• Boşluklar
• Tamam
• Fare ile Toplam İkonuna Basınız

 

[hamitcan]

Sub Add_Totals()

    For Each NumRange In Columns("a").SpecialCells(xlConstants, xlNumbers).Areas
       SumAddr = NumRange.Address(False, False)
       NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
       NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Font.Bold = True
    Next NumRange
    
End Sub

şeklinde deneyin

 

[donjuan1905]

İlginiz için çok çok teşekkür ederim. İki yöntemlede başardım.

Bu arada forumda çok aradım ama bulamadım. Makroları bir command button halinde excel formu üzerine nasıl koyabiliyoruz?

 

[hsayar]

Sub Add_Totals()

    For Each NumRange In Columns("a").SpecialCells(xlConstants, xlNumbers).Areas
       SumAddr = NumRange.Address(False, False)
       NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Formula = "=SUM(" & SumAddr & ")"
       NumRange.Offset(NumRange.Count, 0).Resize(1, 1).Font.Bold = True
    Next NumRange
    
End Sub

şeklinde deneyin

hocam bu satırların açıklmalarını yaparmısınız,
ben 5,3,1 diziindeki 1 in olduğu hücreyi başka bir yerde kullanmak için ne yapmalıyım öreneğin 1(bende metin istanbul, izmir vs.) in olduğu satır j9 ise
ben j9 u

DÜŞEYARA(J9( j sütunundaki bir boş satırdan önceki satır);Bayiler!C267;2;YANLIŞ)

olarak kullanmalıyım

 

[hamitcan]

Sayın hsayar, sorunuzdan fazla birşey anlamadım, Sayın donjuan1905 verdiği örnek gibi bir örnek verebilirseniz, çözüm kolaylaşır.

 

[hsayar]

J sütunundaki boşluklarla ayrılmış satırları bulup, M sütununu toplayacak, toplam için referans aldığı ilk satırın k sütununa toplamı yazacak

yani
J66:J71 boşluklarla ayrılmış, M66:M71 toplanacak G66 ya
J73:J79 boşluklarla ayrılmış, M73:M79 toplanacak G73 e
J81:J88 boşluklarla ayrılmış, M81:M88 toplanacak G81 e

Kabahat bende G yazacağıma k yzmışım



yazılacak

 

[hamitcan]

Aşağıdaki kodu dener misiniz?

Sub Add_Totals2()
    For Each NumRange In Columns("J").SpecialCells(xlConstants, xlNumbers).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
         Cells(Mid(NumRange.Offset(0, 3).Address(False, False), 2, 1), "K") = "=SUM(" & SumAddr & ")"
    Next NumRange
End Sub

 

[hsayar]

hocam çalışma sayfasını ekliyorum, olmadı j numeric değil alfa numeric

Kabahat bende galiba G yazacağıma k yzmışım

 

[hsayar]

bunun gibi 30 40 sayfa olacak

 

[hamitcan]

Sub Add_Totals2()
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "K")) = "=SUM(" & SumAddr & ")"
    Next NumRange
End Sub

şeklinde deneyin.

 

[hsayar]

hocam alakanıza teşekkür ederim bu sefer oldu ama G SÜTUNUNA toplam almam lazım yanlış yazmışım K ye tamam

 

[hsayar]

Sub Add_Totals2()
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
'         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "K")) = "=SUM(" & SumAddr & ")"
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "[B]g[/B]")) = "=SUM(" & SumAddr & ")"
    
    Next NumRange
End Sub

yapınca oldu hocam şu kodları biraz açarmısınız nedir nasıl olur

 

[hsayar]

Sub Add_Totals2()
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
'         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "K")) = "=SUM(" & SumAddr & ")"
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "[B]g[/B]")) = "=SUM(" & SumAddr & ")"
    
    Next NumRange
End Sub

yapınca oldu hocam şu kodları biraz açarmısınız nedir nasıl olur

 

[hamitcan]

Sub Add_Totals2()
    For Each NumRange In Range("j3:j500").SpecialCells(xlCellTypeConstants, 23).Areas
         SumAddr = NumRange.Offset(0, 3).Address(False, False)
         Range(Replace(Split(NumRange.Offset(0, 3).Address(False, False), ":")(0), "M", "G")) = "=SUM(" & SumAddr & ")"
    Next NumRange
End Sub

şeklinde deneyin.

 

[hsayar]

hocam bir sorum daha var toplam alınan aralığın A:j sütunlarına kenarlık uygulatabilrmiyiz
çerçeve yeşil (örnekte siyah ama) kalın çizgi, iç normal siyah çizgi

 

[hamitcan]

Sayın hsayar, inanın son yazdıklarınıza çok güldüm. Lütfen yanlış anlamayın, ilkokul çocuklarının sayfa kenarlarına yaptıkları çiçekleri anımsattı bana.
Not: Yarın bakıp sorunuzu yanıtlamaya çalışırım.

 

[hsayar]

yeşil çünkü o aralık yazıcıdan çıkacak yeşilin diğer tarafında kalan kırmızı ise sayfada görünecek yazıcıdan çıkmayacak
yeşil geç, kırmızı dur misali

asalında olsa şey isteyecem .ok severi ben şu şekilde kenarlıklar vardı

|.|.|
\.\.\
|.|.|
/././
|.|.|

ama yapılmaz işte zorlamayalım exceli

 

[hamitcan]

Sayın hsayar, burada benim yapacağım ne var tam olarak anlayamadım.

 

[hsayar]

J sütunundaki boşluklarla ayrılmış satırları bulup, M sütununu toplayacak, toplam için referans aldığı ilk satırın k sütununa toplamı yazacak

yani
J66:J71boş satırla ayrılmış, A66:J71 yeşil kalın çerçeve kenarlık, iç normal kenarlık, K66:O71 KIRMIZI kalın çerçeve kenarlık, iç normal kenarlık,

J73:J79boş satırla ayrılmış, A73:J79 yeşil kalın çerçeve kenarlık, iç normal kenarlık, K73:O79 KIRMIZI kalın çerçeve kenarlık, iç normal kenarlık,

J81:J88 boş satırla ayrılmış, A81:J88 yeşil kalın çerçeve kenarlık, iç normal kenarlık, K81:O88 KIRMIZI kalın çerçeve kenarlık, iç normal kenarlık

uygulanması münkünmüdür?