Tablolarda Alt Toplam Aldırma Vba İle

1 2 3 4 5 6 7
27/02/2021, 16:13

ercansahiner61

Feraz bey çok teşekkür ederim,
çok güzel olmuş bu kodu düğmeye atamadan  çalıştırmamız mümkün mü acaba
AYRICA ÇOK ÖNEMLİ bir SORUN OLUŞTU.
ALTTOPLAM FORMÜLÜ İLE TOPLAM ALINMADIĞINDAN TOPLAM ÜTÜNDEKİ SON VERİDEN TAB TUŞU VEYA ENTER TUŞU İLE İLE GEZİLDİĞİNDE TOPLAM ÜZERİNDE YENİ SATIŞ AÇMASI LAZIM AÇMIYOR, TOPLAM HÜCRESİNDEN TAB TUŞU İLE ALT SATIRA GEÇİLDTİĞİNDE ALT SATIRA TABLO OLARAK GEÇİYOR
ÇÜNKÜ DENEDİM ELLE ALT TOPLAM OLUŞTURDUĞUMUZ ZAMAN TABLO  DÜZGÜN ÇAMIŞIYOR.
27/02/2021, 18:11

feraz

(27/02/2021, 16:13)ercansahiner61 yazdı: kodu düğmeye atamadan  çalıştırmamız mümkün mü acaba
Rica ederim.
Kod nasıl çalışsın istiyorsunuz?
Yani veri felan değişincemi çalışacak?
27/02/2021, 18:21

feraz

Resimdeki gibi yeride açsanız olur aslında sarıya boyadığım.


27/02/2021, 18:28

feraz

Sizin kod yerine alttaki gibi deneyiniz.
Kod:
Alacak Tutarý
ve
Kod:
Paylaþým tutarý
ve
Kod:
Paylaþým
burayı Tr karakterden dolayı düzeltiniz.

Sub alttoplamlar()
    With Sheets("Paylaþým").ListObjects("Tablo81731")
        .ShowTotals = True
        .ListColumns("Alacak Tutarý").TotalsCalculation = xlTotalsCalculationSum
        .ListColumns("Paylaþým tutarý").TotalsCalculation = xlTotalsCalculationSum
    End With
    MsgBox "Ýþlem tamamlandý", vbInformation, "antonio"
End Sub
27/02/2021, 19:23

feraz

Sanırım Gifteki gibi istiyorsunuz.C ve D sütunua veri girip Tab tuşuna basınız.Otomatik olarak B sütununa geçer.



Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 And Target.Row >= 9 Then
        If Target.Offset(1, -2).Value = "Toplam" Then
            If Target.Value <> "" Then
                If IsNumeric(Target.Value) Then
                    Rows(Target.Row + 1).Insert Shift:=xlDown
                    alttoplamlar
                End If
            End If
        End If
    End If
    End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 5 And Target.Row >= 9 Then
        Target.Offset(1, -2).Select
    End If
End Sub

Sub alttoplamlar()
    With Sheets("Paylaþým").ListObjects("Tablo81731")
        .ShowTotals = True
        .ListColumns("Alacak Tutarý").TotalsCalculation = xlTotalsCalculationSum
        .ListColumns("Paylaþým tutarý").TotalsCalculation = xlTotalsCalculationSum
    End With
'    MsgBox "Ýþlem tamamlandý", vbInformation, "antonio"
End Sub
27/02/2021, 20:22

feraz

Yada D ve E sütunlarında alttıopları açarsanız alttaki gibide yeterli olur.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 And Target.Row >= 9 Then
        If Target.Offset(1, -2).Value = "Toplam" Then
            If Target.Value <> "" Then
                Rows(Target.Row + 1).Insert Shift:=xlDown
            End If
        End If
    End If
    End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 5 And Target.Row >= 9 Then
        Target.Offset(1, -2).Select
    End If
End Sub
1 2 3 4 5 6 7