• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Vergi matrahlarını İlgili Ay ve Kişilere Dağıtmak

htsumer

Altın Üye
Altın Üye
Katılım
7 Eylül 2004
Mesajlar
975
Excel Vers. ve Dili
Excel-2003
Vergi matrahlarını ilgili ay karşılığına göre dağıtacak
Dosya ekte ve açıklaması içindedir..Yardımlarınız bekliyorum..
 

Ekli dosyalar

Son düzenleme:
Aktarım için yardımlarınızı bekliyorum
 
kod:
Kod:
Sub matrah_dağıt()

sayf1 = "EKDERS BORDRO"
sayf2 = "AGİ ve Diğer Veri GirişlerAtama"
sayf3 = "Puantaj"

ay = Worksheets(sayf3).Cells(1, "aj").Value

For i = 7 To Worksheets(sayf1).Cells(Rows.Count, "b").End(3).Row
aranan1 = Worksheets(sayf1).Cells(i, "b").Value
For j = 2 To Worksheets(sayf2).Cells(Rows.Count, "a").End(3).Row
bulunan1 = Worksheets(sayf2).Cells(j, "a").Value
If aranan1 = bulunan1 Then
For r = 9 To 20
If ay = Worksheets(sayf2).Cells(1, r).Value Then
Worksheets(sayf2).Cells(j, r).Value = Worksheets(sayf1).Cells(i, "bb").Value
End If
Next r
End If
Next j
Next i

MsgBox "işlem tamam"

End Sub
 
Çok çok teşekkür ederim harika oldu ..Elinize sağlık hocam..
 
Teşekkürler iyi çalışmalar
 
Bu kodu bir dene
Kod:
Sub matrah_dağıt()
sayf1 = "EKDERS BORDRO"
sayf2 = "AGİ ve Diğer Veri GirişlerAtama"
sayf3 = "Puantaj"
Ay = Worksheets(sayf3).Cells(1, "aj").Value
For i = 7 To Worksheets(sayf1).Cells(Rows.Count, "b").End(3).Row
aranan1 = Worksheets(sayf1).Cells(i, "b").Value
For j = 2 To Worksheets(sayf2).Cells(Rows.Count, "a").End(3).Row
bulunan1 = Worksheets(sayf2).Cells(j, "a").Value
If aranan1 = bulunan1 And bulunan1 > 0 Then
For r = 9 To 20
If Ay = Worksheets(sayf2).Cells(1, r).Value Then
Worksheets(sayf2).Cells(j, r).Value = Worksheets(sayf1).Cells(i, "bb").Value
GoTo atla
End If
Next r
End If
Next j
atla:
Next i
MsgBox "Kümülatif Vergi Matrahı Ayına Ait Aktarılmıştır"

End Sub
 
Tamam hocam harika oldu döngü yapmadı.. Allah sizden razıolsun..
 
Bir tek şey daha kaldı hocam.. Hesaplama sonucu aktar yapıldığında mesela 25 satır aktardık ama bir hata oldu diyelim bordro tekrar yapıldı bu sefer 18 satır oluştu. İlk 25 satır duruyor. 18 satır gelmesi lazım. İlk Aktar öncesi o aktarılanlar silinse iyi olacak..
 
kod:

Kod:
Sub matrah_dağıt()


sayf1 = "EKDERS BORDRO"
sayf2 = "AGİ ve Diğer Veri GirişlerAtama"
sayf3 = "Puantaj"


Ay = Worksheets(sayf3).Cells(1, "aj").Value

For t = 9 To 20
If Ay = Worksheets(sayf2).Cells(1, t).Value Then
Worksheets(sayf2).Range(Worksheets(sayf2).Cells(2, t), Worksheets(sayf2).Cells(Rows.Count, t)).ClearContents
End If
Next t


For i = 7 To Worksheets(sayf1).Cells(Rows.Count, "b").End(3).Row
aranan1 = Worksheets(sayf1).Cells(i, "b").Value
For j = 2 To Worksheets(sayf2).Cells(Rows.Count, "a").End(3).Row
bulunan1 = Worksheets(sayf2).Cells(j, "a").Value
If aranan1 = bulunan1 And bulunan1 > 0 Then
For r = 9 To 20
If Ay = Worksheets(sayf2).Cells(1, r).Value Then
Worksheets(sayf2).Cells(j, r).Value = Worksheets(sayf1).Cells(i, "bb").Value
GoTo atla
End If
Next r
End If
Next j
atla:
Next i
MsgBox "Kümülatif Vergi Matrahı Ayına Ait Aktarılmıştır"

End Sub
 
Teşekkür ederim. Tam istediğim gib oldu. Sağolasınız..Hayırlı çalışmalar
 
Geri
Üst