Bordroda Sayfalar arası veri aktarımı

[ozkovlu]

Merhabalar;
Bordro, V.Matrah, Maaşlar adında sayfalar var. Bu sayfaları buton yardımıyla;
Eğer İsimler(B sütunu) ve Maaş Dönemi(D1 hücresi) ilgili sayfalarda eşit olmak kaydıyla;
1- Bordro sayfasından; Fazla Mesai(H sütunu), Tatil Mesai(I Sütunu), Net Ödenen(AG sütunu), Maaşlar sayfasına,
2- Bordro sayfasından; G.V.M(W sütunu)'u V.Matrah sayfasına,
3- V.Matrah sayfasından; Süregelen Vergi MAtrah(D sütunu)'u Bordro sayfasında Süregelen G.V.M(X sütununa) aktarımının sağlanmasını nasıl sağlayabilirim.

Saygılarımla...


http://s9.dosya.tc/server2/t6ktjg/bordro.xls.html

 

[vardar07]

1- Bordro sayfasından; Fazla Mesai(H sütunu), Tatil Mesai(I Sütunu), Net Ödenen(AG sütunu), Maaşlar sayfasına, hangi sütunlara?
2- Bordro sayfasından; G.V.M(W sütunu)'u V.Matrah sayfasına, hangi sütunlara?
3- V.Matrah sayfasından; Süregelen Vergi MAtrah(D sütunu)'u Bordro sayfasında Süregelen G.V.M(X sütununa) aktarımının sağlanmasını nasıl sağlayabilirim.

Hepsi tek tıklamaylamı olacak,Yukardaki kırmızılı yerleri belirtiniz.

 

[ozkovlu]

Hepsi tek tıklamaylamı olacak

1 ve 2. maadde 1 butonla, 3. madde ayrı butonla,

1- Bordro sayfasından; Fazla Mesai(H sütunu), Tatil Mesai(I Sütunu), Net Ödenen(AG sütunu), Maaşlar sayfasına, hangi sütunlara?

>Maaş Dönemi "Ocak" ise;
* G,H,I Sütunlarına
>Maaş Dönemi "Şubat" ise;
* J,K,L Sütunlarına
>Maaş Dönemi "Mart" ise;
* M,N,O Sütunlarına
>Maaş Dönemi "Nisan" ise;
* P,Q,R Sütunlarına
>Maaş Dönemi "Mayıs" ise;
* S,T,U Sütunlarına
>Maaş Dönemi Haziran ise;
* C,W,X Sütunlarına
>Maaş Dönemi "Temmuz" ise;
* Y,Z,AA Sütunlarına
>Maaş Dönemi "Ağustos" ise;
* AB,AC,AD Sütunlarına
>Maaş Dönemi "Eylül" ise;
* AE,AF,AG Sütunlarına
>Maaş Dönemi "Ekim" ise;
* AH,AI,AJ Sütunlarına
>Maaş Dönemi "Kasım" ise;
* AK,AL,AM Sütunlarına
>Maaş Dönemi "Aralık" ise;
* AN,AO,AP Sütunlarına

2- Bordro sayfasından; G.V.M(W sütunu)'u V.Matrah sayfasına, hangi sütunlara?

>Maaş Dönemi "Ocak" ise;
* E Sütununa
>Maaş Dönemi "Şubat" ise;
* F Sütununa
>Maaş Dönemi "Mart" ise;
* G Sütununa
>Maaş Dönemi "Nisan" ise;
* H Sütununa
>Maaş Dönemi "Mayıs" ise;
* I Sütununa
>Maaş Dönemi Haziran ise;
* J Sütununa
>Maaş Dönemi "Temmuz" ise;
* K Sütununa
>Maaş Dönemi "Ağustos" ise;
* L Sütununa
>Maaş Dönemi "Eylül" ise;
* M Sütununa
>Maaş Dönemi "Ekim" ise;
* N Sütununa
>Maaş Dönemi "Kasım" ise;
* O Sütununa
>Maaş Dönemi "Aralık" ise;
* P Sütununa

 

[ozkovlu]

İşlem uzadığı için sayfanın birini iptal ettim. Belgenin son hali ektedir.
http://s6.dosya.tc/server8/lga3lg/bordro.xls.html

 

[vardar07]

Modül içine ekleyip deneyiniz.

Sub aktar()
Dim  sb As Worksheet, sm As Worksheet
Application.ScreenUpdating = False
Set sb = Sheets("Bordro"): Set sm = Sheets("MaasMesaiMatrah")
For i = 3 To sb.Cells(Rows.Count, "B").End(3).Row
sat = WorksheetFunction.Match(sb.Cells(i, "B"), sm.Range("B:B"), 0)
sut = WorksheetFunction.Match(sb.Cells(1, "D"), sm.Range("A1:BC1"), 0)
sm.Cells(sat, sut) = sb.Cells(sat, "J")
sm.Cells(sat, sut + 1) = sb.Cells(i, "H")
sm.Cells(sat, sut + 2) = sb.Cells(i, "W")
sm.Cells(sat, sut + 3) = sb.Cells(i, "AG")
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Tamamlandı", vbInformation, "ozkovlu"
End Sub

Sub cagır()
Dim  sb As Worksheet,  sm As Worksheet
Application.ScreenUpdating = False
Set sb = Sheets("Bordro"): Set sm = Sheets("MaasMesaiMatrah")
For i = 3 To sb.Cells(Rows.Count, "B").End(3).Row
sat = WorksheetFunction.Match(sb.Cells(i, "B"), sm.Range("B:B"), 0)
[COLOR="Red"]sut = WorksheetFunction.Match(sb.Cells(1, "D"), sm.Range("A1:BC1"), 0)[/COLOR]
[COLOR="Blue"]sb.Cells(i, "X") = sm.Cells(sat, "F")[/COLOR]
[COLOR="Red"]sb.Cells(i, "J") = sm.Cells(sat, sut)
sb.Cells(i, "H") = sm.Cells(sat, sut + 1)
sb.Cells(i, "W") = sm.Cells(sat, sut + 2)
sb.Cells(i, "AG") = sm.Cells(sat, sut + 3)[/COLOR]
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Tamamlandı", vbInformation, "ozkovlu"
End Sub

 

[ozkovlu]

Merhabalar vardar07;
Öncelikle ilginiz için teşekkür ederim.
Çağır makrosunda sadece, "MaasMesaiMatrah" sayfasında Toplam Vergi Matrahı(F Sütunu)'nu "Bordro" sayfasında Süregelen G.V.M(X sütunu)'na aktarılmasını istiyorum.
Saygılarımla...

 

[vardar07]

Üst mesajdaki mavi satırı ekleyip kırmızı satırları siliniz.

 

[ozkovlu]

Sayın vardar07;
Teşekkürler, kod 10 numara 5 yıldız.
Diğer kullanıcılar istifade etmesi için dosyanın son hali ektedir.
Kolay gelsin, iyi çalışmalar...
http://s6.dosya.tc/server8/9mw40p/bordro.zip.html

 

[assenucler]

Merhabalar;

Sayın vardar07 üstada emek ve katkıları için; sayın ozkoylu'ya paylaşımı için teşekkürler.

"Aktar" ve "çağır" düğmeleri ile hangi veriler nereye aktarılıyor ya da çağrılıyor?

Bilgi rica ediyorum.

 

[ozkovlu]

MERHABALAR assenucler;
ilgili açıklama linktedir.
Kolay gelsin.


http://s3.dosya.tc/server10/km40ng/ACIKLAMA.docx.html

 

[assenucler]

"Dosya bulunamadı" mesajını alıyorum.

 

[ozkovlu]

Buradan dener misiniz.
https://drive.google.com/file/d/0ByZb1EuD-6jgcU9yX1R2U0k3UkE/view?usp=sharing

 

[assenucler]

Sayın ozkovlu,

İnceliğiniz ve yardımınız için teşekkürler. Oğlum Gümüşhane Şiran'da askerliğini yapmıştı.
Her şey gönlünüzce olsun.

İstanbul'dan selam ve sevgiler.

 

[ozkovlu]

Sub aktar()
Dim  sb As Worksheet, sm As Worksheet
Application.ScreenUpdating = False
Set sb = Sheets("Bordro"): Set sm = Sheets("MaasMesaiMatrah")
For i = 3 To sb.Cells(Rows.Count, "B").End(3).Row
sat = WorksheetFunction.Match(sb.Cells(i, "B"), sm.Range("B:B"), 0)
sut = WorksheetFunction.Match(sb.Cells(1, "D"), sm.Range("A1:BC1"), 0)
sm.Cells(sat, sut) = sb.Cells(sat, "J")
sm.Cells(sat, sut + 1) = sb.Cells(i, "H")
sm.Cells(sat, sut + 2) = sb.Cells(i, "W")
sm.Cells(sat, sut + 3) = sb.Cells(i, "AG")
Next
Application.ScreenUpdating = True
MsgBox "Aktarma Tamamlandı", vbInformation, "ozkovlu"
End Sub

Sayın @vardar07
Aktarma kodunda şöyle bir hata ile karşılaştım.
"MaasMesaiMatrah" sayfasında personel sayısı "Bordro" sayfasından fazla olduğu zaman Aktarma işleminde kaymalar oluyor.
Bu hatayı nasıl düzeltebiliriz.

Application.ScreenUpdating = False
Set sb = Sheets("BordroMaas"): Set sm = Sheets("MaasMesaiMatrah")
For i = 3 To sb.Cells(Rows.Count, "C").End(3).Row
sat = WorksheetFunction.Match(sb.Cells(i, "C"), sm.Range("B:B"), 0)
sut = WorksheetFunction.Match(sb.Cells(3, "A"), sm.Range("A1:BZ1"), 0)
sm.Cells(sat, sut) = sb.Cells(sat, "V")  'Fazla Mesai
sm.Cells(sat, sut + 1) = sb.Cells(i, "X") 'Tatil Mesai
sm.Cells(sat, sut + 2) = sb.Cells(i, "BC") 'Aylık Vergi Matrahı
sm.Cells(sat, sut + 3) = sb.Cells(i, "CA") 'Toplam Maaş
Next
Application.ScreenUpdating = True