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

tukayf · 13 Ekim 2020

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.

Muzaffer Ali · 13 Ekim 2020

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

tukayf · 13 Ekim 2020

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.

Muzaffer Ali · 13 Ekim 2020

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

tukayf · 13 Ekim 2020

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.

Muzaffer Ali · 13 Ekim 2020

X leri toplayacaktı derken orijinal dosyanızda x yerinde rakam var sanıyordum.
Harfler toplanamadığına göre sayacak o zaman. Doğru mu?

tukayf · 13 Ekim 2020

Doğrudur hocam sayılacak.

Muzaffer Ali · 13 Ekim 2020

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

tukayf · 13 Ekim 2020

Hocam yarın dönüş yapabilirim. Bugün başka işler geldi. tekrardan zihninize sağlık.

tukayf · 14 Ekim 2020

Hocam çok teşekkürler istediğimiz gibi olmuş. Bu sayfadan 13 adet var tek bir komutla bunu tüm sayfalara nasıl uygulayabilirim.

Muzaffer Ali · 14 Ekim 2020

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

tukayf · 14 Ekim 2020

Çok sağolun hocam. Bu şekliyle tam oldu. Zihninize sağlık.

Muzaffer Ali · 14 Ekim 2020

Rica ederim. Kolay gelsin.

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

tukayf

Ekli dosyalar

Muzaffer Ali

Destek Ekibi

tukayf

Muzaffer Ali

Destek Ekibi

tukayf

Muzaffer Ali

Destek Ekibi

tukayf

Muzaffer Ali

Destek Ekibi

tukayf

tukayf

Muzaffer Ali

Destek Ekibi

tukayf

Muzaffer Ali

Destek Ekibi