Süregelen gelir vergisi matrahını aktarmak

[unur]

İyi Günler;

Bordroda personelin adı soyadı yada tc kimlik numarasından yararlanarak hangi ayın bordrosunu yapmışsam bir buton sayesinde bordrodaki aylık gelir vergisini bilgiler sayfasında aylık gelir vergisi matrahını ilgili ay hanesine aktarmak istiyorum gelir vergisini süregelen gelir vergisi matrahına göre kesinti yapabilmek için.

Teşekkürler.

 

[unur]

Güncellemek için

 

[unur]

Arkadaşlar acaba derdimi mi tam olarak anlatamadım 1. mesajdaki sorum konusunda fikir sahibi olan kimse yok mu?
Teşekkürler.

 

[halit3]

Cevap gelmiyorsa muhtemelen izah yetersiz ben sizin yerinizde olsam BORDRO sayfasındaki sarı renkli bölümleri BİLGİLER sayfasında şu aya ait değerleri manuel olması gerekenleri yapar sorumu ona göre yenilerdim.

Örnek dosyanızdaki BORDRO sayfasındaki verileri hangi aya ait olduğunu yazar ve BİLGİLER sayfasında şu hücreye aktar diye bir açıklayıcı bilgi gerek

 

[unur]

İyi akşamlar.
Sorumu biraz daha toparlamaya çalışayım.
Bordro Sayfasına bir buton eklemek
Örnek: Bordro sayfasında L1 hücresinde ocak ayı yazıyor. Butona tıklandığında kırmızı renkli hücre ile gösterdiğim gelir vergisi matrahlarını Bilgiler sayfasında ilgili kişilerin karşısındaki ilgili aya aktarmak istiyorum.
Eğer bordroda olan kişi bilgiler sayfasında kişi yoksa kişiyi bilgiler sayfasına ekleyip ilgili aya gelir vergisi matrahını aktarmak istiyorum.

Umarım açıklayabilmişimdir. Şimdiden Teşekkürler.

 

[halit3]

Bu kodu bir dene

Sub aktar()

ay = Sheets("BORDRO").Cells(1, 12).Value

For r = 10 To Worksheets("BORDRO").Cells(Rows.Count, "A").End(3).Row Step 5
aranan1 = Sheets("BORDRO").Cells(r, 2).Value & " " & Sheets("BORDRO").Cells(r + 1, 2).Value

For i = 10 To Worksheets("BİLGİLER").Cells(Rows.Count, "B").End(3).Row
bulunan1 = Sheets("BİLGİLER").Cells(i, 1).Value
deg = 0
If bulunan1 = aranan1 Then
deg = 1
For s = 5 To 16
If Sheets("BİLGİLER").Cells(9, s).Value = ay Then
Sheets("BİLGİLER").Cells(i, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
GoTo atla
End If
Next s
End If

Next i
If deg = 0 Then
say = Worksheets("BİLGİLER").Cells(Rows.Count, "B").End(3).Row + 1
For s = 5 To 16
If Sheets("BİLGİLER").Cells(9, s).Value = ay Then
Sheets("BİLGİLER").Cells(say, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
Sheets("BİLGİLER").Cells(say, 1).Value = aranan1
Sheets("BİLGİLER").Cells(say, 2).Value = Sheets("BORDRO").Cells(r + 2, 2).Value
GoTo atla
End If
Next s
End If

atla:
Next r

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[unur]

Çok Teşekkürler Halit Bey;
Küçük bir ilave yapabilir miyiz. Daha önce ilgili aya matrahlar aktarılmışsa ilgili ayın matrahı daha önce aktarılmış uyarı mesajı verip aktarılmasa yada yine de aktarmak istiyormusunuz EVET HAYIR şeklinde bir uyarı çıkıp devam etse, Hangisi daha kolayınıza gelirse
Teşekkürler

 

[halit3]

kod:

Sub aktar()

ay = Sheets("BORDRO").Cells(1, 12).Value

For r = 10 To Worksheets("BORDRO").Cells(Rows.Count, "A").End(3).Row Step 5
aranan1 = Sheets("BORDRO").Cells(r, 2).Value & " " & Sheets("BORDRO").Cells(r + 1, 2).Value

For i = 10 To Worksheets("BİLGİLER").Cells(Rows.Count, "B").End(3).Row
bulunan1 = Sheets("BİLGİLER").Cells(i, 1).Value
deg = 0
If bulunan1 = aranan1 Then
deg = 1
For s = 5 To 16
If Sheets("BİLGİLER").Cells(9, s).Value = ay Then

If Sheets("BİLGİLER").Cells(i, s).Value > 0 Then
msg1 = MsgBox(aranan1 & Chr(10) & "Aktarolsınmı.? ", vbYesNo + vbInformation, "u y a r ı !")
If msg1 = vbYes Then
Sheets("BİLGİLER").Cells(i, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
End If
Else
Sheets("BİLGİLER").Cells(i, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
End If

GoTo atla
End If
Next s
End If

Next i
If deg = 0 Then
say = Worksheets("BİLGİLER").Cells(Rows.Count, "B").End(3).Row + 1
For s = 5 To 16
If Sheets("BİLGİLER").Cells(9, s).Value = ay Then
Sheets("BİLGİLER").Cells(say, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
Sheets("BİLGİLER").Cells(say, 1).Value = aranan1
Sheets("BİLGİLER").Cells(say, 2).Value = Sheets("BORDRO").Cells(r + 2, 2).Value
GoTo atla
End If
Next s
End If

atla:
Next r

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[halit3]

bun da uyarı mesajı detaylı

Sub aktar()

ay = Sheets("BORDRO").Cells(1, 12).Value

For r = 10 To Worksheets("BORDRO").Cells(Rows.Count, "A").End(3).Row Step 5
aranan1 = Sheets("BORDRO").Cells(r, 2).Value & " " & Sheets("BORDRO").Cells(r + 1, 2).Value

For i = 10 To Worksheets("BİLGİLER").Cells(Rows.Count, "B").End(3).Row
bulunan1 = Sheets("BİLGİLER").Cells(i, 1).Value
deg = 0
If bulunan1 = aranan1 Then
deg = 1
For s = 5 To 16
If Sheets("BİLGİLER").Cells(9, s).Value = ay Then

If Sheets("BİLGİLER").Cells(i, s).Value > 0 Then
msg1 = MsgBox(aranan1 & Chr(10) & "eski " & Sheets("BİLGİLER").Cells(i, s).Value & _
Chr(10) & "yeni " & Sheets("BORDRO").Cells(r + 2, 10).Value & Chr(10) & "Aktarolsınmı.? ", vbYesNo + vbInformation, "u y a r ı !")
If msg1 = vbYes Then
Sheets("BİLGİLER").Cells(i, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
End If
Else
Sheets("BİLGİLER").Cells(i, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
End If

GoTo atla
End If
Next s
End If

Next i
If deg = 0 Then
say = Worksheets("BİLGİLER").Cells(Rows.Count, "B").End(3).Row + 1
For s = 5 To 16
If Sheets("BİLGİLER").Cells(9, s).Value = ay Then
Sheets("BİLGİLER").Cells(say, s).Value = Sheets("BORDRO").Cells(r + 2, 10).Value
Sheets("BİLGİLER").Cells(say, 1).Value = aranan1
Sheets("BİLGİLER").Cells(say, 2).Value = Sheets("BORDRO").Cells(r + 2, 2).Value
GoTo atla
End If
Next s
End If

atla:
Next r

MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

 

[unur]

Çok teşekkürler Halit Bey; Allah razı olsun

 

[halit3]

Çok teşekkürler Halit Bey; Allah razı olsun

Teşekkürler iyi çalışmalar