Alt satırda toplamları göstermek

Y

yavuz829

Katılım
8 Mart 2007
Mesajlar
582
Excel Vers. ve Dili
excel 2000 Türkçe
Altın Üyelik Bitiş Tarihi
29-04-2021
Arkadaşlar dosyam büyük olduğu için yükleyemedim. Aşağıdaki kodlarla verileri giriyorum son satırda toplamları gösteriyor.
Satır veriyi silip veya verileri değiştirdiğim zaman alttaki toplamlar değişmiyor aynı kalıyor.

Kod: 
Private Sub CommandButton1_Click()
'Application.ScreenUpdating = False 'Kodları hızlı çalışması için
ActiveSheet.Unprotect "6810"
If ComboBox2 = "" Then
MsgBox "...!!!.KAYIT BAŞARISIZ.!!!...LÜTFEN TARİHİ BOŞ GEÇMEYİNİZ. TARİHİ BOŞ GEÇERSENİZ VERİLERİNİZ KAYIT EDİLMİYECEK", vbInformation
Exit Sub: End If
On Error Resume Next
ActiveSheet.ShowAllData
If ActiveSheet.AutoFilterMode Then ActiveSheet.Range("A1").AutoFilter Field:=1
On Error Resume Next
Dim i As Integer, ts
For i = 6 To 32000
If (ActiveSheet.Cells(i, 1) = "") Then
ActiveSheet.Cells(i, 2) = CDate(ComboBox2)
ActiveSheet.Cells(i, 3) = ComboBox3.Text
ActiveSheet.Cells(i, 4) = TextBox3.Text * 1
ActiveSheet.Cells(i, 5) = TextBox4.Text * 1
ActiveSheet.Cells(i, 6) = TextBox5.Text * 1
ActiveSheet.Cells(i, 7) = TextBox10.Text * 1
ActiveSheet.Cells(i, 8) = TextBox11.Text * 1
ActiveSheet.Cells(i, 9) = TextBox13.Text * 1
ActiveSheet.Cells(i, 10) = TextBox6.Text * 1
ActiveSheet.Cells(i, 11) = TextBox7.Text * 1
ActiveSheet.Cells(i, 12) = ComboBox1.Text
ts = Range("B" & Rows.Count).End(xlUp).Row
Range("A6") = 1
Range("A6:A" & ts).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, step:=1, Trend:=False
MsgBox "KAYIT YAPILDI!...", vbOKOnly + vbInformation, "Bilgi Ekleme"
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & [A65536].End(3).Row
Range("A65535").End(xlUp).Offset(1, 0).Select
'Hızlı kaydet başı
Application.Calculation = xlManual
ActiveWorkbook.Save
Application.Calculation = xlAutomatic
ComboBox2.SetFocus 'Başlama yeri
'Hızlı kaydet sonu
'''''''''
'Son satırda toplamları gösterir başı
son = Cells(65536, "k").End(xlUp).Row + 1
Cells(son, "l") = WorksheetFunction.Sum(Range("l6:l65536"))
Cells(son, "k") = WorksheetFunction.Sum(Range("k6:k65536"))
Cells(son, "j") = WorksheetFunction.Sum(Range("j6:j65536"))
Cells(son, "ı") = WorksheetFunction.Sum(Range("ı6:ı65536"))
Cells(son, "h") = WorksheetFunction.Sum(Range("h6:h65536"))
Cells(son, "f") = WorksheetFunction.Sum(Range("f6:f65536"))
Cells(son, "b") = (Range("a1:a1"))
'Son satırda toplamları gösterir sonu
 
Dim TC As Control 'UserForm Temizle'
    For Each TC In Controls
        If TypeName(TC) = "TextBox" Or TypeName(TC) = "ComboBox" Then
            TC.Value = ""
        End If
    Next TC
   Set TC = Nothing
'UserForm Temizle'
ActiveSheet.Protect "6810"
CommandButton2_Click
TextBox8.Text = [P1]
TextBox16.Text = [Q1]
TextBox9.Text = [K4]
ComboBox2.Text = ""
TextBox15.Text = [M1]
UserForm_Initialize
ListBox1.ListIndex = [A65536].End(3).Row - 1 'LİSTBOX A SON BOŞ SATIR EKLER
ListBox1.ListIndex = ListBox1.ListCount - 1 'ListBoxın son satırına gider.'
Range("A65535").End(xlUp).Offset(1, 0).Select 'Son boş satıra gider

Exit Sub
End If
Next i
End Sub
Kod: 
Private Sub CommandButton12_Click()
ActiveSheet.Unprotect "6810"
If ComboBox2.Text = "" Then
MsgBox " LÜTFEN DEĞİŞTİRİLECEK VERİNİN BUL İLE SIRA NUMARASINI GİRİNİZ!!!"
Exit Sub
End If
sifre = InputBox("!!!...DEĞİŞTİRMEK İSTEDİĞİNİZ SATIRI ÇİFT TIKLAYARAK YUKARIDAKİ GİRİŞ KUTUCUKLARINA GELMESİNİ SAĞLAYIN. YUKARIDAKİ KUTUCUKLAR BOŞ OLDUĞU ZAMAN SEÇTİĞİNİZ VERİLER SİLİNMİŞTİR UYARISINI ALSANIZ BİLE VERİLERİ SİLMEZ...!!!  !!!...YUKARIDAKİ GİRİŞ KUTUCUKLARI DOLU İSE ŞİFREYİ GİRİNİZ...!!!")
ActiveSheet.Protect "6810"
If sifre <> "1" Then MsgBox "YANLIŞ ŞİFRE GİRDİNİZ ! LÜTFEN KONTROL EDİN.": Exit Sub
ActiveSheet.Unprotect "6810"
If sifre = "" Then Exit Sub
MsgBox "KAYIT DEĞİŞTİRİLDİ!!!"
satır = ActiveCell.Row
ListBox1.RowSource = ""
On Error Resume Next
ActiveSheet.Unprotect "6810"
ActiveCell.Offset(0, 1).Value = CDate(ComboBox2.Value)
ActiveCell.Offset(0, 2).Value = ComboBox3.Value
ActiveCell.Offset(0, 3).Value = CDbl(TextBox3.Value)
ActiveCell.Offset(0, 4).Value = CDbl(TextBox4.Value)
ActiveCell.Offset(0, 5).Value = CDbl(TextBox5.Value)
ActiveCell.Offset(0, 6).Value = CDbl(TextBox10.Value)
ActiveCell.Offset(0, 7).Value = CDbl(TextBox11.Value)
ActiveCell.Offset(0, 8).Value = CDbl(TextBox13.Value)
ActiveCell.Offset(0, 9).Value = CDbl(TextBox6.Value)
ActiveCell.Offset(0, 10).Value = CDbl(TextBox7.Value)
On Error GoTo 0
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & [A65536].End(3).Row
Range("A65535").End(xlUp).Offset(1, 0).Select
ComboBox2.SetFocus
ActiveSheet.Protect "6810"
CommandButton2_Click
TextBox8.Text = [L4]
TextBox9.Text = [L6]
ComboBox2.Text = ""
TextBox15.Text = [M1]
UserForm_Initialize
ListBox1.ListIndex = ListBox1.ListCount - 1 'ListBoxın son satırına gider.'
Range("A65535").End(xlUp).Offset(1, 0).Select 'Son boş satıra gider
End Sub
Kod: 
Private Sub CommandButton15_Click()
ActiveSheet.Unprotect "6810"
If ComboBox2.Text = "" Then
MsgBox " LÜTFEN SİLİNECEK VERİNİN BUL İLE SIRA NUMARASINI GİRİNİZ!!!"
Exit Sub
End If
sifre = InputBox("!!!...SİLMEK İSTEDİĞİNİZ SATIRI ÇİFT TIKLAYARAK YUKARIDAKİ GİRİŞ KUTUCUKLARINA GELMESİNİ SAĞLAYIN. YUKARIDAKİ KUTUCUKLAR BOŞ OLDUĞU ZAMAN SEÇTİĞİNİZ VERİLER SİLİNMİŞTİR UYARISINI ALSANIZ BİLE VERİLERİ SİLMEZ...!!!  !!!...YUKARIDAKİ GİRİŞ KUTUCUKLARI DOLU İSE ŞİFREYİ GİRİNİZ...!!!")
ActiveSheet.Protect "6810"
If sifre <> "1" Then MsgBox "YANLIŞ ŞİFRE GİRDİNİZ ! LÜTFEN KONTROL EDİN.": Exit Sub
ActiveSheet.Unprotect "6810"
If sifre = "" Then Exit Sub
Dim Arr()
Application.ScreenUpdating = False
       For Each R In Selection.Rows
    If R.Row <= 5 Then
ActiveSheet.Protect "6810"
MsgBox "İlk beş satırı silemezsiniz..", vbExclamation, "UYARI"
ActiveSheet.Protect "6810"
Exit Sub
End If
        c = c + 1
     ReDim Preserve Arr(1 To c)
     Arr(c) = R.Row
     Next
    First = LBound(Arr)
    Last = UBound(Arr)
    For i = First To Last - 1
        For j = i + 1 To Last
            If Arr(i) < Arr(j) Then
                Temp = Arr(j)
                Arr(j) = Arr(i)
                Arr(i) = Temp
            End If
        Next j
    Next i
    For k = 1 To UBound(Arr)
        Rows(Arr(k)).Delete
    Next
  Application.ScreenUpdating = True
  MsgBox "!!!.SEÇTİĞİNİZ VERİLER SİLİNMİŞTİR.!!!"
ActiveSheet.Protect "6810"
Range("A65535").End(xlUp).Offset(1, 0).Select
ComboBox2.SetFocus
ActiveWorkbook.Save ' Kayıt yapar
CommandButton2_Click
TextBox8.Text = [L4]
TextBox9.Text = [L6]
ComboBox2.Text = ""
TextBox15.Text = [M1]
UserForm_Initialize
ListBox1.ListIndex = ListBox1.ListCount - 1 'ListBoxın son satırına gider.'
Range("A65535").End(xlUp).Offset(1, 0).Select 'Son boş satıra gider
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst