• DİKKAT

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

son dolu satırın altına toplam alma imza açma ve koşullu biçimlendirme

tukayf

tukayf

Katılım
9 Eylül 2010
Mesajlar
879
Excel Vers. ve Dili
2016&2019&2021 TR
Değerli hocalarım kitap içerisinde de açıklamaları yazdım. Acceste yapılmış bir programdan veri çekiyoruz. Şablon olarak elimizde bulunan excel dosyasındaki sayfaların altına otomatik toplam ve genel toplam ile koşullu biçimlendirme yapmak istiyorum. Yardımlarınız için şimdiden teşekkürler.
 

Ekli dosyalar

Merhaba
Aşağıdaki kodu dener misiniz?

Kod: 
Sub Test()
    Dim Bak As Long
    Dim Kolon As Integer
    Dim Satir As Integer
    Satir = Cells(Rows.Count, "D").End(xlUp).Row + 1
    
    Cells(Satir, "D") = "Toplam"
    Cells(Satir + 1, "D") = "Genel"
    
    For Kolon = 5 To Cells(2, Columns.Count).End(xlToLeft).Column
        Cells(Satir, Kolon) = WorksheetFunction.Sum(Cells(3, Kolon).Resize(Satir))
    Next
    Cells(Satir + 1, 5) = WorksheetFunction.Sum(Cells(3, 5).Resize(Satir - 3, Kolon - 5))
    
    With Cells(3, 5).Resize(Satir - 3, Kolon - 5)
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"
        .FormatConditions(1).Interior.ThemeColor = xlThemeColorAccent6
    End With
    
    Range("E14:K14").Merge
    Range("E15:K15").Merge
    Range("E16:K16").Merge
    Range("E14") = "Ahmet Mehmet"
    Range("E15") = "Memur"
    Range("E16") = "Memur"
    Range("E14:K16").HorizontalAlignment = xlCenter

    Range("O14:U14").Merge
    Range("O15:U15").Merge
    Range("O16:U16").Merge
    Range("O14") = "Ali Veli"
    Range("O15") = "Amir"
    Range("O16") = "Amir"
    Range("O14:U16").HorizontalAlignment = xlCenter

    Range("Y14:AE14").Merge
    Range("Y15:AE15").Merge
    Range("Y16:AE16").Merge
    Range("Y14") = "Hasan Hüseyin"
    Range("Y15") = "Müdür"
    Range("Y16") = "Müdür"
    Range("Y14:AE16").HorizontalAlignment = xlCenter
    
    Range("E14:K16,O14:U16,Y14:AE16").Interior.ThemeColor = xlThemeColorAccent5
    Range("E14:K16,O14:U16,Y14:AE16").Interior.TintAndShade = 0.399975585192419
End Sub
 
Hocam cevap için teşekkürler ancak imza kısmı da son Genel satırından sonraki satırın 4 altına gelecek şekilde olmalıydı.
Bununla birlikte 15 sayfa için kodu her sayfanın sayfa kodu kısmına mı yazmam lazım.
 
Tekrar dener misiniz?
Kodu herhangi bir modüle kopyalayın, Sayfanın kod kısmına değil.
Aktif olan sayfada işlem yapar.

Kod: 
Sub Test()
    Dim Bak As Long
    Dim Kolon As Integer
    Dim Satir As Integer
    Dim Adres As String
    
    Satir = Cells(Rows.Count, "D").End(xlUp).Row + 1
    
    Cells(Satir, "D") = "Toplam"
    Cells(Satir + 1, "D") = "Genel"
    
    For Kolon = 5 To Cells(2, Columns.Count).End(xlToLeft).Column
        Cells(Satir, Kolon) = WorksheetFunction.Sum(Cells(3, Kolon).Resize(Satir))
    Next
    Cells(Satir + 1, 5) = WorksheetFunction.Sum(Cells(3, 5).Resize(Satir - 3, Kolon - 5))
    
    With Cells(3, 5).Resize(Satir - 3, Kolon - 5)
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"
        .FormatConditions(1).Interior.ThemeColor = xlThemeColorAccent6
    End With
    
    Range("E" & Satir + 6 & ":K" & Satir + 6).Merge
    Range("E" & Satir + 7 & ":K" & Satir + 7).Merge
    Range("E" & Satir + 8 & ":K" & Satir + 8).Merge
    Range("E" & Satir + 6) = "Ahmet Mehmet"
    Range("E" & Satir + 7) = "Memur"
    Range("E" & Satir + 8) = "Memur"
    Range("E" & Satir + 6 & ":K" & Satir + 9).HorizontalAlignment = xlCenter
    
    Range("O" & Satir + 6 & ":U" & Satir + 6).Merge
    Range("O" & Satir + 7 & ":U" & Satir + 7).Merge
    Range("O" & Satir + 8 & ":U" & Satir + 8).Merge
    Range("O" & Satir + 6) = "Ali Veli"
    Range("O" & Satir + 7) = "Amir"
    Range("O" & Satir + 8) = "Amir"
    Range("O" & Satir + 6 & ":U" & Satir + 9).HorizontalAlignment = xlCenter

    Range("Y" & Satir + 6 & ":AE" & Satir + 6).Merge
    Range("Y" & Satir + 7 & ":AE" & Satir + 7).Merge
    Range("Y" & Satir + 8 & ":AE" & Satir + 8).Merge
    Range("Y" & Satir + 6) = "Ali Veli"
    Range("Y" & Satir + 7) = "Amir"
    Range("Y" & Satir + 8) = "Amir"
    Range("Y" & Satir + 6 & ":AE" & Satir + 9).HorizontalAlignment = xlCenter

    Adres = "E" & Satir + 6 & ":K" & Satir + 8 & ", O" & Satir + 6 & ":U" & Satir + 8 & ",Y" & Satir + 6 & ":AE" & Satir + 8
    Range(Adres).Interior.ThemeColor = xlThemeColorAccent5
    Range(Adres).Interior.TintAndShade = 0.399975585192419
End Sub
 
Hocam çok özür dileyerek toplamda X leri toplayacaktı. Genelde ise toplamların tümünü toplayacaktı. Onnun dışında tamam gibi. Zihninize sağlık.
 
X leri toplayacaktı derken orijinal dosyanızda x yerinde rakam var sanıyordum.
Harfler toplanamadığına göre sayacak o zaman. Doğru mu?
 
Kod: 
Sub Test()
    Dim Bak As Long
    Dim Kolon As Integer
    Dim Satir As Integer
    Dim Adres As String
    
    Satir = Cells(Rows.Count, "C").End(xlUp).Row + 1
    
    Cells(Satir, "D") = "Toplam"
    Cells(Satir + 1, "D") = "Genel"
    
    For Kolon = 5 To Cells(2, Columns.Count).End(xlToLeft).Column
        Cells(Satir, Kolon) = WorksheetFunction.CountIf(Cells(3, Kolon).Resize(Satir), "x")
    Next
    Cells(Satir + 1, 5) = WorksheetFunction.CountIf(Cells(3, 5).Resize(Satir - 3, Kolon - 5), "x")
    
    With Cells(3, 5).Resize(Satir - 3, Kolon - 5)
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"
        .FormatConditions(1).Interior.ThemeColor = xlThemeColorAccent6
    End With
    
    Range("E" & Satir + 6 & ":K" & Satir + 6).Merge
    Range("E" & Satir + 7 & ":K" & Satir + 7).Merge
    Range("E" & Satir + 8 & ":K" & Satir + 8).Merge
    Range("E" & Satir + 6) = "Ahmet Mehmet"
    Range("E" & Satir + 7) = "Memur"
    Range("E" & Satir + 8) = "Memur"
    Range("E" & Satir + 6 & ":K" & Satir + 9).HorizontalAlignment = xlCenter
    
    Range("O" & Satir + 6 & ":U" & Satir + 6).Merge
    Range("O" & Satir + 7 & ":U" & Satir + 7).Merge
    Range("O" & Satir + 8 & ":U" & Satir + 8).Merge
    Range("O" & Satir + 6) = "Ali Veli"
    Range("O" & Satir + 7) = "Amir"
    Range("O" & Satir + 8) = "Amir"
    Range("O" & Satir + 6 & ":U" & Satir + 9).HorizontalAlignment = xlCenter

    Range("Y" & Satir + 6 & ":AE" & Satir + 6).Merge
    Range("Y" & Satir + 7 & ":AE" & Satir + 7).Merge
    Range("Y" & Satir + 8 & ":AE" & Satir + 8).Merge
    Range("Y" & Satir + 6) = "Ali Veli"
    Range("Y" & Satir + 7) = "Amir"
    Range("Y" & Satir + 8) = "Amir"
    Range("Y" & Satir + 6 & ":AE" & Satir + 9).HorizontalAlignment = xlCenter

    Adres = "E" & Satir + 6 & ":K" & Satir + 8 & ", O" & Satir + 6 & ":U" & Satir + 8 & ",Y" & Satir + 6 & ":AE" & Satir + 8
    Range(Adres).Interior.ThemeColor = xlThemeColorAccent5
    Range(Adres).Interior.TintAndShade = 0.399975585192419
End Sub
 
Hocam yarın dönüş yapabilirim. Bugün başka işler geldi. tekrardan zihninize sağlık.
 
Hocam çok teşekkürler istediğimiz gibi olmuş. Bu sayfadan 13 adet var tek bir komutla bunu tüm sayfalara nasıl uygulayabilirim.
 
O zaman aşağıdaki kodları kullanın.
syf = Array("İstanbul", "Adana", "Hatay") Buraya kendi sayfalarınızın adını yazın.
Kod: 
Sub Test()
    Dim syf As Variant
    Dim Bak As Variant
    syf = Array("Adana", "Hatay")
    For Each Bak In syf
        Alt_Toplam ThisWorkbook.Worksheets(Bak)
    Next
End Sub

Sub Alt_Toplam(syf As Worksheet)
    Dim Bak As Long
    Dim Kolon As Integer
    Dim Satir As Integer
    Dim Adres As String
   
    Satir = syf.Cells(Rows.Count, "C").End(xlUp).Row + 1
   
    syf.Cells(Satir, "D") = "Toplam"
    syf.Cells(Satir + 1, "D") = "Genel"
   
    For Kolon = 5 To syf.Cells(2, Columns.Count).End(xlToLeft).Column
        syf.Cells(Satir, Kolon) = WorksheetFunction.CountIf(syf.Cells(3, Kolon).Resize(Satir), "x")
    Next
    syf.Cells(Satir + 1, 5) = WorksheetFunction.CountIf(syf.Cells(3, 5).Resize(Satir - 3, Kolon - 5), "x")
   
    With syf.Cells(3, 5).Resize(Satir - 3, Kolon - 5)
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=0"
        .FormatConditions(1).Interior.ThemeColor = xlThemeColorAccent6
    End With
   
    syf.Range("E" & Satir + 6 & ":K" & Satir + 6).Merge
    syf.Range("E" & Satir + 7 & ":K" & Satir + 7).Merge
    syf.Range("E" & Satir + 8 & ":K" & Satir + 8).Merge
    syf.Range("E" & Satir + 6) = "Ahmet Mehmet"
    syf.Range("E" & Satir + 7) = "Memur"
    syf.Range("E" & Satir + 8) = "Memur"
    syf.Range("E" & Satir + 6 & ":K" & Satir + 9).HorizontalAlignment = xlCenter
   
    syf.Range("O" & Satir + 6 & ":U" & Satir + 6).Merge
    syf.Range("O" & Satir + 7 & ":U" & Satir + 7).Merge
    syf.Range("O" & Satir + 8 & ":U" & Satir + 8).Merge
    syf.Range("O" & Satir + 6) = "Ali Veli"
    syf.Range("O" & Satir + 7) = "Amir"
    syf.Range("O" & Satir + 8) = "Amir"
    syf.Range("O" & Satir + 6 & ":U" & Satir + 9).HorizontalAlignment = xlCenter

    syf.Range("Y" & Satir + 6 & ":AE" & Satir + 6).Merge
    syf.Range("Y" & Satir + 7 & ":AE" & Satir + 7).Merge
    syf.Range("Y" & Satir + 8 & ":AE" & Satir + 8).Merge
    syf.Range("Y" & Satir + 6) = "Ali Veli"
    syf.Range("Y" & Satir + 7) = "Amir"
    syf.Range("Y" & Satir + 8) = "Amir"
    syf.Range("Y" & Satir + 6 & ":AE" & Satir + 9).HorizontalAlignment = xlCenter

    Adres = "E" & Satir + 6 & ":K" & Satir + 8 & ", O" & Satir + 6 & ":U" & Satir + 8 & ",Y" & Satir + 6 & ":AE" & Satir + 8
    syf.Range(Adres).Interior.ThemeColor = xlThemeColorAccent5
    syf.Range(Adres).Interior.TintAndShade = 0.399975585192419
End Sub
 
Rica ederim. Kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst