10 adet sayfanın c1,g1;h1 hücrelerinin ana sayfadaki aynı hücrelere kodla toplam alma

[polis-53]

merhaba arkadaşlar ekte gönderdiğim doysada sayfa2;sayfa3;sayfa4;sayfa5;sayfa6;sayfa7;sayfa8 deki b4,b6,b8,.. gibu hücrelerin toplamını ana sayfada aynı hücrelere kodla toplatmak. yardım ederseniz çok sevinirim acil lazım dün cevap verildi fakat formülle cevaplandı benim istediğim kodla yapılsın.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub SAYFALARDAN_TOPLAM_AL()
    Dim HÜCRE As Range, SAYFA As Worksheet, BUL As Range
    
    For Each HÜCRE In Sheets("ANA SAYFA").Range("A:A").SpecialCells(xlCellTypeConstants, 23)
        HÜCRE.Offset(0, 1).ClearContents
        For Each SAYFA In ThisWorkbook.Worksheets
            If SAYFA.Name <> "ANA SAYFA" Then
                Set BUL = SAYFA.Cells.Find(HÜCRE.Value, LookAt:=xlWhole)
                If Not BUL Is Nothing Then
                    HÜCRE.Offset(0, 1).Value = HÜCRE.Offset(0, 1).Value + BUL.Offset(0, 1).Value
                End If
            End If
        Next
    Next
    
    Set BUL = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[mancubus]

araya işler girince Korhan Hocamız'ın cevabını görmedim.

verilen emek boşa gitmesin diye ekliyorum.

Sub sayfa_aynıhücre_topla()
    
    Dim sht As Worksheet, wks As Worksheet
    Dim toplam As Double
    Dim rng As Range, cll As Range
    
    Set wks = Worksheets("ANA SAYFA")
    wks.Columns("B").ClearContents
    
    Set rng = wks.Columns("A").SpecialCells(xlCellTypeConstants, 23)
    For Each cll In rng
        toplam = 0
        For Each sht In ThisWorkbook.Worksheets
            If sht.Name <> wks.Name Then
                toplam = toplam + sht.Cells(cll.Row, 2)
            End If
        Next
        cll.Offset(0, 1) = toplam
    Next cll
    
End Sub

 

[polis-53]

Çooooooook teşekkür ederim Korhan bey vermiş olduğunuz kod çok güzel ben açıklamayı unuttum sayfalarda boş olan hücrelerde formulüm var ana sayfada kodla tüm sayfaların toplamlarını alırken förmüllü hücrelere dokunmayacak sadece değer olan yani formülsüz hücreler hücreler toplanacak asıl dosyayı ekliyorum icmal sayfasındaki formülsüz hücreleri yani değer olan hücreleri toplasın.

 

[polis-53]

Çooooooook teşekkür ederim Korhan bey vermiş olduğunuz kod çok güzel ben açıklamayı unuttum sayfalarda boş olan hücrelerde formulüm var ana sayfada kodla tüm sayfaların toplamlarını alırken förmüllü hücrelere dokunmayacak sadece değer olan yani formülsüz hücreler hücreler toplanacak asıl dosyayı ekliyorum icmal sayfasındaki formülsüz hücreleri yani değer olan hücreleri toplasın.

 

[polis-53]

korhan ve mancubus arkadaşlar cevap verdiniz sağolun ancak yukarda açıkladığım gibi olacaktı yardımlarınızı bekliyorum elleriniz dert görmesin.

 

[mancubus]

örneğiniz sorudaki yapıdan farklı.

tam olarak sayfalardaki hangi aynı satırların toplanarak eklenmesini istiyorsunuz?
örnek: İCMAL hariç bütün sayfalardaki C5 hücrelerinde yer alan verilerin toplamını İCMAL C5'e yaz

veya hangi kurala uyan (hepsi için standart) satırların verileri toplanacak:
örnek: İCMAL A sütunundaki AAA, BBB, GGG, ZZZ değerlerini diğer tüm sayfalarda ara bulduğun hücrenin 3 sağındaki / 5 solundaki / vs hücrelerin toplamını icmal e yaz.

 

[polis-53]

merhabalar tüm saflalardaki formullu hücreler hariç hepsi için standart satırların verileri toplanacak örnek dosyada icmal sayfasında görüldüğü gibi renkli hücreler hariç diğer hücreleri toplayacak örneğin C8,C9C,C12,C15C18,... devam eden renksiz hücrelerin toplamını alacak. tablo her sayfada standarttır.

 

[mancubus]

yani İCMAL sayfası C sütununa bakılacak. formül varsa atlanacak, yoksa (hücre boşsa veya rakam, metin varsa) diğer sayfalardaki aynı hücreleri toplayacak.

dosyanızın bir kopyasını alarak aşağıdaki kodu deneyin.

Option Explicit
 
Sub SAYFALARDAN_TOPLAM_AL()
    Dim HÜCRE As Range
    
    For Each HÜCRE In Sheets("İCMAL").Range("C:C")
        If HÜCRE.HasFormula Then
        Else
            HÜCRE.FormulaR1C1 = "=SUM('1:10'!RC)"
            HÜCRE.Value = HÜCRE.Value
        End If
    Next
    
End Sub

 

[Necdet]

Merhaba,

Bende birşeyler yapmıştım öğlen yemğe çıkınca eklemek gecikti.

Sub Topla()
    Dim i   As Long, _
        Syf As Integer
 
    Syf = Sheets.Count - 1
    Sheets("İCMAL").Select
 
    For i = 8 To Cells(Rows.Count, "A").End(3).Row
        If Not Cells(i, "C").HasFormula Then _
            Cells(i, "C") = Evaluate("=SUM('1:" & Syf & "'!C" & i & ")")
    Next i
End Sub

 

[polis-53]

teşekkür ederim sayın mancubus ve necatCells(i, "C") = Evaluate("=SUM('1:" & Syf & "'!C" & i & ")")
bu kod sayfaların adı 1,2,3,... diye hesaplıyor arada boşluk olduğu zaman örneğin 1,3,8,... veya ahmet, mehmet,... gibi olduğu zaman hata veriyor. bununda duzeltebilirseniz çok sevinirim. Elleriniz dert görmesin Allah yar ve yardımcınız olsun kalın sağlıcakla

 

[mancubus]

sn polis53

verdiğiniz örnek dosyadan şablon gibi olduğu anlaşılıyor. kodlar da ona göre hazırlanıyor.
durumunuz farklı ise ona göre örnek vermek ve durumu detaylı izah etmek yardımcı olur.

aktardığım koddaki "=SUM('1:10'!RC)" formülü en soldaki sayfa ismi 1 ve en sağdaki sayfa ismi 10 olmak üzere aradaki bütün sayfaların aynı hücrelerini toplar. arada 50 sayfa olsa ve isimleri değişik olsa da önemli değil.

siz kendi fiili durumunuza uyarlayablirsiniz.

 

[mancubus]

pratiklik açısından şöyle bir şey denenebilir.

icmal'den sonra gelmek üzere "başla" isminde bir boş sayfa, en sona "bitir" isminde boş bir sayfa eklenir.

formül şu şekilde kullanılır: "=SUM('başla:bitir'!RC)"

 

[polis-53]

sayın mancubus sizin vermiş olduğunuz kod zaten hata verdi çalışmadı
necdet beyin kodu çalıştı ama safyalar arası boşluk veya sayfa isimleri değişik olduğu zaman çalışmıyor bunun düzeltilmesini istiyorum

 

[mancubus]

sayın mancubus sizin vermiş olduğunuz kod zaten hata verdi çalışmadı
necdet beyin kodu çalıştı ama safyalar arası boşluk veya sayfa isimleri değişik olduğu zaman çalışmıyor bunun düzeltilmesini istiyorum

ilginç.

yüklediğiniz dosya üzerinde deneyip çalıştığını gördükten sonra eklemiştim. üstelik manuel olarak toplayıp kontrol ettikten sonra.

iyi günler.