Hem düşeyara hem de aynı anda hesapla

  • Konuyu başlatan Konuyu başlatan berkbaba
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

berkbaba

Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
ekli dosyamın vba kısmı incelendiğinde makro kodu ile birinci aşamada isime ait bilgileri DATA kısmında getirmesi ikinci aşamada da bordro sayfasında H sütununa tutar girince de (gelir vergisi, damga vergisi, kesintiler toplamı, ele geçen) hesaplama yapması gerekiyor.

dosya incelendiğinde ikinci aşama olan hesaplamayı yapıyor, birinci aşama olan isme ait bilgileri getirmiyor.

Sizlerden istirhamım
1 - Bordro sayfasında İsim girildiği zaman hem bilgileri getirsin hem de hesaplasın. (ikinci aşamaya gerek kalmasın)
2 - Bordro sayfasında isim sildiğim zaman da aynı satırdaki tüm bilgiler de silinsin.
 
VBA Browser Checked = TRUE döndürme Sorunu
Makro ile aktar

Ekli dosyalar

Tarihe göre sırala Oylamaya göre sırala
Merhaba.
Umarım yanlış anlamadım. Mevcut kod'un yerine aşağıdakini dener misiniz?

H sütunundaki sayısal veri silindiğinde hesaplama alanı silinir, B sütunundaki veri silindiğinde ise satırdaki tüm veriler silinir.

İlave açıklama:
-- Şayet DATA sayfasındaki Bürüt Ücret, BORDRO sayfasında Tahakkuk Toplamı sütununa aktarılıp
(başlık farklı olduğundan emin olamadım) buna göre hasaplama da yapılacaksa;
kod'da kırmızı renklendirdiğim satırı silin.
-- Şayet BORDRO sayfası H sütuna sadece elle veri girişi yapılacaksa yeşil renklendirdiğim satırı silin.
VBA: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Row < 3 Or Target.Row > 23 Or (Target.Column <> 2 And Target.Column <> 8) Then Exit Sub

If Target.Column = 2 Then
    If Target = "" Or WorksheetFunction.CountIf(Sheets("DATA").[B:B], Target) = 0 Then
        Range("C" & Target.Row & ":M" & Target.Row).ClearContents
    ElseIf Target <> "" And WorksheetFunction.CountIf([B3:B24], Target) > 1 Then
        MsgBox "Mükerrer kayıt", vbCritical
        Range("B" & Target.Row & ":M" & Target.Row).ClearContents
        Target.Activate
    ElseIf Target <> "" And WorksheetFunction.CountIf(Sheets("DATA").[B:B], Target) = 1 Then
        a = WorksheetFunction.Match(Target.Value, Sheets("DATA").[B:B], 0)
        Target.Offset(0, 1) = Sheets("DATA").Cells(a, "C")
        Target.Offset(0, 2) = Sheets("DATA").Cells(a, "D")
        Target.Offset(0, 3) = Sheets("DATA").Cells(a, "E")
        Target.Offset(0, 4) = Sheets("DATA").Cells(a, "F")
        Target.Offset(0, 5) = Sheets("DATA").Cells(a, "I")
        Target.Offset(0, 7) = Sheets("DATA").Cells(a, "G")
[B][COLOR=rgb(43, 84, 44)]        Target.Offset(0, 6) = Sheets("DATA").Cells(a, "H")[/COLOR]
[COLOR=rgb(132, 53, 52)]        Target.Offset(0, 6).Activate[/COLOR][/B]
    End If
ElseIf Target.Column = 8 Then
    If Target = 0 Or Target = "" Then
        Range("J" & Target.Row & ":M" & Target.Row).ClearContents
    ElseIf Target > 0 And Cells(Target.Row, 2) = "" Then
        Range("B" & Target.Row & ":M" & Target.Row).ClearContents
    Else
        sat = Target.Row
        Cells(sat, "K") = WorksheetFunction.Round(Cells(sat, "H") * Sheets("Katsayılar").Range("F2"), 2)
        Cells(sat, "L") = WorksheetFunction.RoundUp(Cells(sat, "J") + Cells(sat, "K"), 2)
        Cells(sat, "M") = WorksheetFunction.RoundUp(Cells(sat, "H") - Cells(sat, "L"), 2)
        Cells(sat, "J") = GELİR(Cells(sat, "I"), Cells(sat, "H"))
    End If
End If

End Sub
 
Oyla 0 Olumsuz oyla
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst