• DİKKAT

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

toplam al ve çerceve çiz

P

prodigy

Katılım
25 Aralık 2005
Mesajlar
219
sayfamda adı soyadı ve alacak dan oluşan listem var her liste arasında bir sutun boş olacak şekilde bu liste tekrar ederek devam ediyor. listenin hangi sutunda ve kaç satırda biteceği belli değil.
a1 den başlayarak her listedeki alacak sütununu toplayıp, listeyi çerçeve içine almak istiyorum. (ekteki ekran alıntısı gibi)
 

Ekli dosyalar

  • Ekran Alıntısı.jpg
    Ekran Alıntısı.jpg
    17.5 KB · Görüntüleme: 31
REsim yerine örnek dosya ekleseydiniz daha iyi olurdu.

Başlangıç olarak şöyle bir kod hazırladım. Ancak maalesef çalışmadı. Bir yerlerde hata yaptığım açık ancak neresi ben bulamadım. Eğer hatayı düzeltebilirsem üzerinden devam ederek çalışmayı tamamlayabiliriz. tecrübeli arkadaşlardan kodumdaki hatayı göstermelerini rica ediyorum. Ancak lütfen tam çözüm değil benim kodun hatasını bildirsinler mümkünse:
Kod: 
Sub düzenle()
On Error GoTo 10
a = Range("XFD1").End(xlToLeft).Row
For i = 1 To a
If Cells(1, i) = "soyadı" Then
b = Cells(1, i).End(xlDown).Column
Cells(b + 1, i) = "TOPLAM"
Cells(b + 1, i + 1) = Application.Sum(Cells(1, i) & ":" & Cells(b, i))
End If
Next
10:
End Sub

Bu arada hata kontrolü satırını iptal ettiğimde de sonuç alamadım. makro çalıştığında hiçbir şey olmuyor nedense.
 
Pardon, buldum hatayı.

a = Range("XFD1").End(xlToLeft).Row

değil

a = Range("XFD1").End(xlToLeft).Column

olacak tabi :)

acemilik ve dikkatsizlik böyle bir şey demek ki.

Ancak kodlarda yine hata varmış, TOPLAM satırını yanlış hücrelere yerleştiriyor.
 
xlToLeft ve xlToRight yön sabitlerini COLUMN için, xlDown ve xlUp yön sabitlerini ise ROW için kullanın.
 
Onu düzelttim. TOPLAM ve toplamı doğru yerlere yerleştirme tamam ancak bu sefer de toplam aldıramadım.

Cells(b + 1, i + 1) = Application.Sum(Cells(2, i) & ":" & Cells(b, i))

yapınca hücrede #DEĞER yazıyor.
Kod: 
Sub düzenle()
On Error GoTo 10
For i = 1 To Range("XFD1").End(xlToLeft).Column
If Cells(1, i) = "soyadı" Then
b = Cells(1, i).End(xlDown).Row
Cells(b + 1, i) = "TOPLAM"
Cells(b + 1, i + 1) = Application.Sum(Cells(2, i) & ":" & Cells(b, i))
End If
Next
10:
End Sub
 
Onu da buldum, sütunu yanlış vermişim :(
Kod: 
Sub düzenle()
On Error GoTo 10
For i = 1 To Range("XFD1").End(xlToLeft).Column
If Cells(1, i) = "soyadı" Then
b = Cells(1, i).End(xlDown).Row
Cells(b + 1, i) = "TOPLAM"
Cells(b + 1, i + 1) = WorksheetFunction.Sum(Cells(2, i + 1) & ":" & Cells(b, i + 1))
End If
Next
10:
End Sub

bu sefer de toplam yerine farklı bir işlem yapıyor. Örneğin 4 tane 1'in toplamını 0,0423611111111111 olarak buluyor nedense.
 
Kod: 
Sub alan_toplamı_al()

    Dim sonsat As Long, sonsut As Long, sut As Long
    
    sonsut = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For sut = 1 To sonsut
        If Cells(1, sut) = "soyadı" Then
            sonsat = Cells(Rows.Count, sut).End(xlUp).Row
            Cells(sonsat + 1, sut) = "TOPLAM"
            Cells(sonsat + 1, sut + 1) = Application.Sum(Range(Cells(2, sut + 1), Cells(sonsat, sut + 1)))
        End If
    Next

End Sub
 
MOD fonksiyonu kullanılarak alternatif çözüm...

Kod: 
Sub alan_toplamı_al_2()

    Dim sonsat As Long, sonsut As Long, sut As Long
 
    Columns(1).Insert

    sonsut = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For sut = 1 To sonsut
        If sut Mod 4 = 0 Then
            sonsat = Cells(Rows.Count, sut).End(xlUp).Row
            Cells(sonsat + 1, sut - 1) = "TOPLAM"
            Cells(sonsat + 1, sut) = Application.Sum(Range(Cells(2, sut), Cells(sonsat, sut)))
        End If
    Next

    Columns(1).Delete

End Sub
 
Merhaba,

Alternatif olarak aşağıdaki kodu da kullanabilirsiniz.

Kod: 
Sub TABLOYU_DUZENLE()
    Dim X As Integer, Son As Integer
    
    For X = 1 To Cells(1, Columns.Count).End(1).Column Step 4
        Son = Cells(Rows.Count, X).End(3).Row + 1
        Cells(Son, X + 1) = "TOPLAM"
        Cells(Son, X + 2) = WorksheetFunction.Sum(Range(Cells(2, X + 2), Cells(Son - 1, X + 2)))
        Range(Cells(1, X), Cells(Son, X + 2)).Borders.LineStyle = 1
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Teşekkürler arkadaşlar. Yardımınızla son haline getirdim:
Kod: 
Sub düzenle()
'On Error GoTo 10
ActiveSheet.Range(["a:xfd"]).Borders.LineStyle = 0
For i = 1 To Range("XFD1").End(xlToLeft).Column
If Cells(1, i) = "soyadı" Then
b = Cells(1, i).End(xlDown).Row
Cells(b + 1, i) = "TOPLAM"
Cells(b + 1, i + 1) = WorksheetFunction.Sum(Range(Cells(2, i + 1), Cells(b, i + 1)))
Range(Cells(1, i - 1), Cells(b + 1, i + 1)).Borders.LineStyle = 1
End If
Next
10:
End Sub

istenirse bu kodun sonuna sayın Korhan Bey'in kodunda olduğu gibi işlem tamam mesajı eklenebilir. Benim kodlarım başlık satırında "soyadı" ifadesini görünce işlem yapıyor. Farklı çözümler yukarda da belirtildiği gibi var, örneğin Korhan Bey 4 sütunda bir olacak şakilde yaptırmış. Sonuçta Excel bir deniz, makro bir okyanus, yapmaya çalıştığımız ise bir damla :)
 
Şöyle daha güzel oldu sanki:
Kod: 
Sub düzenle()
On Error GoTo 10
ActiveSheet.Range(["a:xfd"]).Borders.LineStyle = 0
For i = 1 To Range("XFD1").End(xlToLeft).Column
If Cells(1, i) = "soyadı" Then
b = Cells(1, i).End(xlDown).Row
Cells(b + 1, i) = "TOPLAM"
Cells(b + 1, i + 1) = WorksheetFunction.Sum(Range(Cells(2, i + 1), Cells(b, i + 1)))
Range(Cells(1, i - 1), Cells(b + 1, i + 1)).Borders.LineStyle = 1
With Range(Cells(1, i - 1), Cells(1, i + 1))
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End If
Next
10:
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Alternatif olarak aşağıdaki kodu da kullanabilirsiniz.

Kod: 
Sub TABLOYU_DUZENLE()
    Dim X As Integer, Son As Integer
    
    For X = 1 To Cells(1, Columns.Count).End(1).Column Step 4
        Son = Cells(Rows.Count, X).End(3).Row + 1
        Cells(Son, X + 1) = "TOPLAM"
        Cells(Son, X + 2) = WorksheetFunction.Sum(Range(Cells(2, X + 2), Cells(Son - 1, X + 2)))
        Range(Cells(1, X), Cells(Son, X + 2)).Borders.LineStyle = 1
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

İyi geceler, forumda yaptığım araştırmalarda en yakın bu kodu buldum ancak kodlardan anlamıyorum, benimde bir listem var, bu listemde son satıra toplam aldırmak istiyorum toplam aldıracağım sutun F sütunu, Kodlarda nasıl bir revizyon yapmamız gerekir.Yardımcı olacak arkadaşlara şimdiden teşekkürler.
 
unur' Alıntı:
İyi geceler, forumda yaptığım araştırmalarda en yakın bu kodu buldum ancak kodlardan anlamıyorum, benimde bir listem var, bu listemde son satıra toplam aldırmak istiyorum toplam aldıracağım sutun F sütunu, Kodlarda nasıl bir revizyon yapmamız gerekir.Yardımcı olacak arkadaşlara şimdiden teşekkürler.
Genişletmek için tıkla ...

Sorunuzu bir örnek dosyayla destekleyip yeni bir konuda sorarsanız daha kolay çözüm bulunur.
 
Yusuf bey, bunun için örnek bir dosyaya gerek var mı bilmiyorum? bir tablom var. Bu tablomun (satır sayısı değişken oluyor) F sütununun toplamını almak istiyorum en son satıra. (Sayfa aktif olduğunda olabilir) (Dosya işyerinde olduğu için ekleyemiyorum. Teşekkürler.
 
Kod: 
Application.enableevents =False
Son = Cells(Rows.Count, "F" ).End(3).Row
Cells(Son+1, "F") = WorksheetFunction.Sum(Range("F1:F"&son))
Application.enableevents =True

Yukardaki kodlarý ilgili sayfanýn kod bölümünde Worksheet Activate olayýný seçip araya yapýþtýrýrsanýz sayfa aktif olduðunda toplama yapar. (cepten sayfa aktif kodunu yazamadým maalesef)

F sütununa yeni veri girerseniz baþka sayfaya geçip geri döndüðünüzde yeniden hesaplar.
 
Teşekkürler Yusuf bey; Veriler başka sayfadan aldığım için çıktı alabilmek için mecbur sayfayı aktif edeceğiz, onun için problem yok. Aslında toplamı son satırda (satır sayısı değişken olduğu için) formüllerle yapamadığım için bu yola başvurdum.

Toplam aldığımız hücrenin solundaki hücreye de TOPLAM yazdırabilir miyiz?

(İkinci satırdaki "F" yerine "E" yazdım. çünkü diğer türlü her girip çıktığımda toplam altına yeni toplam alıyordu)

(Tüm bunları formülle yapabilirsek, (yapılabilir mi bilmiyorum) makrosuz bir dosyam olur.)

Teşekkürler.
 
Son düzenleme:
Kod: 
Application.enableevents =False
Son = Cells(Rows.Count, "F" ).End(3).Row
Cells(Son+1, "F") = WorksheetFunction.Sum(Range("F1:F"&son))
[B]Cells(Son+1, "E") = "TOPLAM"[/B] 
Application.enableevents =True

Şeklinde deneyin.
 
Şimdi deneme yaptım. Aşağıdaki kodları kullanırsanız istediğinize daha uygun oluyor, sayfa aktif edildiğinde TOPLAM yazıp toplama yapıyor, başka sayfaya geçildiğinde bunları siliyor:

Kod: 
Private Sub Worksheet_Activate()
Application.EnableEvents = False
Son = Cells(Rows.Count, "F").End(3).Row
Cells(Son + 1, "F") = WorksheetFunction.Sum(Range("F1:F" & Son))
Cells(Son + 1, "E") = "TOPLAM"
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Deactivate()
Application.EnableEvents = False
Son = Cells(Rows.Count, "F").End(3).Row
Cells(Son, "F") = ""
Cells(Son, "E") = ""
Application.EnableEvents = True
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst