Banka Listesinden Ücretsiz izinlileri çıkarma...

[Hacı Bayram ÖZKAN]

Merhaba arkadaşalar;
Personel listesi dosyasından promosyon ödemesi için Banka dosyası oluşturuyorum. Ancak isteğim S Kolonunda Ücretsiz izinli olanları almasın bunun için aşağıdaki kodu kullandım ama olmadı nasıl bir değişiklik yapmam lazım.

Sub PROMOSYON_İÇİN_VAKIFBANK() 'VAKIF

Dosya = "D:\Belgelerim\Banka\VAKIFBANK.xlsx"

SonSat = Cells(Rows.Count, "A").End(3).Row
'-----------------------------------------------------
'düzenleyen paraflarıda kaydedilecekse
'sonsat = Range("B:H").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'-----------------------------------------------------
Set aç = New Excel.Application
aç.Workbooks.Open Dosya
Set hz = aç.Workbooks(Dir(Dosya))
Set syf = hz.Sheets(1)

syf.Range("A11:E" & 65536) = Empty

Dim a
a = InputBox("ÖDEME TARİHİNİ GİRİNİZ", "LÜTFEN DİKKAT", Date + 2)
syf.Range("C4").Value = a

For t = 2 To SonSat

If Cells(t, "S") <> "ÜCRETSİZ İZİNLİ" Then ' Bunu ekledim ama
syf.Range("A" & t + 9).Value = Range("C" & t).Value & " " & Range("D" & t).Value
Next ' Burda duruyor. Nasıl bir değişiklik yapmam lazım.

For i = 2 To SonSat
syf.Cells(i + 9, "B") = Right(Cells(i, "K"), 17)
Next i

syf.Range("C11:C" & SonSat + 9).Value = Range("G2:G" & SonSat).Value 'B T.C.
syf.Range("D11" & SonSat + 9).Value = "500"
syf.Range("E11:E" & SonSat + 9).Value = Range("K2:K" & SonSat).Value 'ad iban
End If

hz.Close SaveChanges:=True
aç.Quit
Set aç = Nothing: Set hz = Nothing

MsgBox "Banka Listesi Oluşturuldu.." & vbCrLf & "Bankaya Göndermek İçin Kontrol Edin."

'Sonra

Workbooks.Open "D:\Belgelerim\Banka\VAKIFBANK.xlsx"

End Sub

 

[YUSUF44]

Cells(t, "S") hücresinin hangi dosya ve sayfada olduğunu belirtmeniz gerekir muhtemelen. Anladığım kadarıyla bu haliyle makroyla açılan Vakıfbank.xlsx dosyasının S sütununa bakıyor ama aslında gönderdiğiniz dosyanın S sütununa bakması gerekiyor.

 

[Hacı Bayram ÖZKAN]

Evet doğru dediğiniz gibiymiş peki nasıl yapmam lazım.

 

[YUSUF44]

Dosya satırından önce

ana = Activeworkbook

satırını ekleyip,

If Cells(t, "S") <> "ÜCRETSİZ İZİNLİ" Then ' Bunu ekledim ama

satırını

If ana.sheets("Sayfa1").Cells(t, "S") <> "ÜCRETSİZ İZİNLİ" Then

olarak değiştirin.

Makronun diğer bölümlerinde de gerekirse ana.sheets("Sayfa1"). kısmını kullanın.

 

[Hacı Bayram ÖZKAN]

Sayın abim o olmadı da şöyle bir şey uyguladım. Oluyor ancak.

Sub PROMOSYON_İÇİN_VAKIFBANK() 'VAKIF

Dosya = "D:\Belgelerim\Banka\VAKIF.xlsx"
SonSat = Cells(Rows.Count, "A").End(3).Row
'-----------------------------------------------------
'düzenleyen paraflarıda kaydedilecekse
'sonsat = Range("B:H").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'-----------------------------------------------------
Set aç = New Excel.Application
aç.Workbooks.Open Dosya
Set hz = aç.Workbooks(Dir(Dosya))
Set syf = hz.Sheets(1)

syf.Range("A11:E" & 65536) = Empty

Dim a
a = InputBox("ÖDEME TARİHİNİ GİRİNİZ", "LÜTFEN DİKKAT", Date + 2)
syf.Range("C4").Value = a
sat = 11
For t = 2 To SonSat

If Cells(t, "S") <> "ÜCRETSİZ İZİNLİ" Then

syf.Range("A" & sat).Value = Range("C" & t).Value & " " & Range("D" & t).Value
syf.Range("C" & sat).Value = Range("G" & t).Value
syf.Range("D" & sat).Value = "500"
syf.Range("E" & sat).Value = Range("K" & t).Value
sat = sat + 1
End If
Next

hz.Close SaveChanges:=True
aç.Quit
Set aç = Nothing: Set hz = Nothing

MsgBox "Banka Listesi Oluşturuldu.." & vbCrLf & "Bankaya Göndermek İçin Kontrol Edin."

'Sonra

Workbooks.Open "D:\Belgelerim\Banka\VAKIF.xlsx"

End Sub

Bu kod oluyor ama VAKIF dosyasının B Kolonuna İbanın sağdan 17 hanesini yazdıracağım onu da aşağıdaki kod yapılor.

For i = 2 To SonSat
syf.Cells(i + 9, "B") = Right(Cells(i, "K"), 17)
Next i

ancak bunun nereye yazacağımı bulamadım. Next satırından sonra yazınca oluyor ama ücretsiz izinli olanın hesap numarasını silmiyor. Bana bunun için yardımcı olur musun? Teşekkürler.

 

[YUSUF44]

Diğer verileri aktardığınız mevcut For next döngüsü içine aşağıdaki satırı ekleyebilirsiniz:

syf.Range("B" & sat).Value = Right(Cells(i, "K"), 17)

 

[Hacı Bayram ÖZKAN]

Sayın Yusuf abim bu dediğinizi daha önce denedim olmuyor, ancak
For i = 2 To SonSat
syf.Cells(i + 9, "B") = Right(Cells(i, "K"), 17)
Next i
Bu kodlarla oluyor, bu seferde ÜCRETSİZ izinlerde sorun çıkıyor,
Bunu bana Necdet bey önermişti.
Neyse abim teşekkür ederim. Sizi yordum, bu şekil kullanacağım. Teşekkürler.

 

[YUSUF44]

Bunun olmaması bana mantıklı gelmiyor. Temelde bu kodun diğer iş gören kodlardan bir farkı yok ki?

 

[Hacı Bayram ÖZKAN]

Sayın abim galiba bu VakıfBank'ın dosyası ile alakalı Çünkü aynı kot sizin dediğiniz gibi İş Bankası'nda iken oluyordu sonra VakıfBank'a geçince olmamaya başladı sağ olsun Necdet Bey de Size söylediğim kodu bana yazmıştı bu şekil oluyor sorun yok ama ücretsiz izinleri düzgün yapmıyor o dediğim kodu nexten sonra girince Bu sefer de Vakıfbank dosyasının ücretsiz izini personelin b kolonundaki Hesap numaralarını Silmiyor ilgine ve alakana teşekkür ediyorum İyi günler diliyorum Allah'a emanet ol

 

[YUSUF44]

Bildiğim kadarıyla Vakıfbank otomatik yükleme dosyasının E sütununda zaten IBAN'lar yer alıyor. Bundan yararlanarak

sat=sat+1

satırının üstüne aşağıdaki satırı ekleyip dener misiniz?

syf.Range("B" & sat).Value = Right(syf.Range("K" & sat), 17)

 

[Ömer]

Merhaba,

Yada; sat=sat+1 satırından önce aşağıdaki gibi yazılabilir.

syf.Range("B" & sat).Value = Right(Range("K" & t).Value, 17)

Tam kod:

Sub PROMOSYON_İÇİN_VAKIFBANK() 'VAKIF

Dosya = "D:\Belgelerim\Banka\VAKIF.xlsx"
SonSat = Cells(Rows.Count, "A").End(3).Row
'-----------------------------------------------------
'düzenleyen paraflarıda kaydedilecekse
'sonsat = Range("B:H").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'-----------------------------------------------------
Set aç = New Excel.Application
aç.Workbooks.Open Dosya
Set hz = aç.Workbooks(Dir(Dosya))
Set syf = hz.Sheets(1)

syf.Range("A11:E" & 65536) = Empty

Dim a
a = InputBox("ÖDEME TARİHİNİ GİRİNİZ", "LÜTFEN DİKKAT", Date + 2)
syf.Range("C4").Value = a
sat = 11
For t = 2 To SonSat

If Cells(t, "S") <> "ÜCRETSİZ İZİNLİ" Then

syf.Range("A" & sat).Value = Range("C" & t).Value & " " & Range("D" & t).Value
syf.Range("C" & sat).Value = Range("G" & t).Value
syf.Range("D" & sat).Value = "500"
syf.Range("E" & sat).Value = Range("K" & t).Value
syf.Range("B" & sat).Value = Right(Range("K" & t).Value, 17) ' ilave ****
sat = sat + 1
End If
Next

hz.Close SaveChanges:=True
aç.Quit
Set aç = Nothing: Set hz = Nothing

MsgBox "Banka Listesi Oluşturuldu.." & vbCrLf & "Bankaya Göndermek İçin Kontrol Edin."

'Sonra

Workbooks.Open "D:\Belgelerim\Banka\VAKIF.xlsx"

End Sub

 

[Hacı Bayram ÖZKAN]

Hayır abim yine olmuyor. Tek bir şekilde oluyor. Oda bu

Sub PROMOSYON_İÇİN_VAKIFBANK() 'VAKIF


Dosya = "D:\Belgelerim\Banka\VAKIF.xlsx"
SonSat = Cells(Rows.Count, "A").End(3).Row
'-----------------------------------------------------
'düzenleyen paraflarıda kaydedilecekse
'sonsat = Range("B:H").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'-----------------------------------------------------
Set aç = New Excel.Application
aç.Workbooks.Open Dosya
Set hz = aç.Workbooks(Dir(Dosya))
Set syf = hz.Sheets(1)

syf.Range("A11:E" & 65536) = Empty

Dim a
a = InputBox("ÖDEME TARİHİNİ GİRİNİZ", "LÜTFEN DİKKAT", Date + 2)
syf.Range("C4").Value = a
sat = 11


For t = 2 To SonSat



If Cells(t, "S") <> "ÜCRETSİZ İZİNLİ" Then

syf.Range("A" & sat).Value = Range("C" & t).Value & " " & Range("D" & t).Value


syf.Range("C" & sat).Value = Range("G" & t).Value
syf.Range("D" & sat).Value = "500"
syf.Range("E" & sat).Value = Range("K" & t).Value
sat = sat + 1
End If
Next

For i = 2 To SonSat
syf.Cells(i + 9, "B") = Right(Cells(i, "K"), 17)
Next i

hz.Close SaveChanges:=True
aç.Quit
Set aç = Nothing: Set hz = Nothing

MsgBox "Banka Listesi Oluşturuldu.." & vbCrLf & "Bankaya Göndermek İçin Kontrol Edin."

'Sonra

Workbooks.Open "D:\Belgelerim\Banka\VAKIF.xlsx"

End Sub

Böyle oluncada ekdeki dosyayı incelersen ücretsiz izinli personelin sadece hesabını bırakıyor. Diğerleri doğru geliyor.

 

[Ömer]

#11. messajda verdiğim kodları denediniz mi?

 

[Hacı Bayram ÖZKAN]

Sayın Yusuf abiciğim Ömer beyin yazdığı kod tam olarak çalıştı abim. Her ikinize de çok teşekkür ederim. Özellikle Yusuf abim seni yordum. Kusuruma bakma abim iyi akşamlar.

 

[Hacı Bayram ÖZKAN]

#11. messajda verdiğim kodları denediniz mi?

Abim tam yazıyordum.

 

[Hacı Bayram ÖZKAN]

Her ikinizede teşekkür ederim hallettiniz. Emeğinize sağlık dua ile kalın.