• DİKKAT

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

seçmeli Bilgi aktarımı

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
Değerli abilerim;
Ekli dosyamda Tüm Liste ve Aylık Terfisi gelenler gelenler olmak üzere iki tane sayfam var.

tüm liste sayfamda G1 hücresinde ay seçilip,
- Derece Terfisi Gelenleri aktar
- Kademe Terfisi Gelenleri aktar
seçeneklerinden biri check yapıldığı zaman Aylık terfisi gelenler bölümüne B6 dan itibaren alfabetik olarak alt alta aktarılsın. Altta boş satır kalırsa gizlensin, Ay değiştirilip de ikinci bir tercihte ilk aktarılanlar silinip yerine yenisi aktarılsın. Aktarılanların Dolgu rengi Gri yazı rengi mavi olsun.

Rica etsem bu işlemler için yardımcı olabilir misiniz?

Dosya Linki : http://www.divshare.com/download/25229270-64e
 
Değerli abilerim;
Ekli dosyamda Tüm Liste ve Aylık Terfisi gelenler gelenler olmak üzere iki tane sayfam var.

tüm liste sayfamda G1 hücresinde ay seçilip,
- Derece Terfisi Gelenleri aktar
- Kademe Terfisi Gelenleri aktar
seçeneklerinden biri check yapıldığı zaman Aylık terfisi gelenler bölümüne B6 dan itibaren alfabetik olarak alt alta aktarılsın. Altta boş satır kalırsa gizlensin, Ay değiştirilip de ikinci bir tercihte ilk aktarılanlar silinip yerine yenisi aktarılsın. Aktarılanların Dolgu rengi Gri yazı rengi mavi olsun.

Rica etsem bu işlemler için yardımcı olabilir misiniz?

Dosya Linki : http://www.divshare.com/download/25229270-64e

kodları komut düğmelerine yazdım.

Kod:
Sub aktar1()

Dim s1, s2
Set s1 = Sheets("TÜM LİSTE")
Set s2 = Sheets("AYLIK TERFİSİ GELENLER")
ay = s1.Cells(1, "G").Value
Tarih = Val(Format("01." & Format(ay, "00") & "." & Format(Format(Now, "yyyy"), "0000"), "mm"))

s2.Range("A6:Q65536").ClearContents
s1.Range("A3:O500").Interior.ColorIndex = xlNone
s1.Range("A3:O500").Font.ColorIndex = 0

sat = 6

For r = 3 To s1.[f65536].End(3).Row
If s1.Cells(r, "k").Value <> "" Then
aranan = CDate(s1.Cells(r, "k").Value)

s1.Cells(r, "k").Value = CDate(s1.Cells(r, "k").Value)


If Val(Format(aranan, "dd")) <= 14 Then
If Val(Format(aranan, "mm")) = Tarih Then

s1.Range("A" & r & ":O" & r).Interior.ColorIndex = 15
s1.Range("A" & r & ":O" & r).Font.ColorIndex = 5


s2.Cells(sat, 1).Value = sat - 5
s2.Cells(sat, 2).Value = s1.Cells(r, 4).Value
s2.Cells(sat, 3).Value = s1.Cells(r, 3).Value
s2.Cells(sat, 4).Value = s1.Cells(r, 6).Value
s2.Cells(sat, 5).Value = s1.Cells(r, 7).Value
s2.Cells(sat, 6).Value = s1.Cells(r, 5).Value


s2.Cells(sat, 7).Value = s1.Cells(r, 8).Value
s2.Cells(sat, 8).Value = s1.Cells(r, 9).Value
s2.Cells(sat, 9).Value = s1.Cells(r, 10).Value
If s1.Cells(r, 11).Value <> "" Then
s2.Cells(sat, 10).Value = CDate(s1.Cells(r, 11).Value)
End If
s2.Cells(sat, 11).Value = s1.Cells(r, 12).Value
s2.Cells(sat, 12).Value = s1.Cells(r, 13).Value
s2.Cells(sat, 13).Value = s1.Cells(r, 14).Value
If s1.Cells(r, 15).Value <> "" Then
s2.Cells(sat, 14).Value = CDate(s1.Cells(r, 15).Value)

End If

sat = sat + 1
End If
End If
If Tarih = 1 Then
ser = 12
Else
ser = 0
End If

If Val(Mid(aranan, 1, 2)) > 14 Then
If Val(Mid(aranan, 4, 2)) = Tarih - 1 + ser Then
s1.Range("A" & r & ":O" & r).Interior.ColorIndex = 15
s1.Range("A" & r & ":O" & r).Font.ColorIndex = 5

s2.Cells(sat, 1).Value = sat - 5
s2.Cells(sat, 2).Value = s1.Cells(r, 4).Value
s2.Cells(sat, 3).Value = s1.Cells(r, 3).Value
s2.Cells(sat, 4).Value = s1.Cells(r, 6).Value
s2.Cells(sat, 5).Value = s1.Cells(r, 7).Value
s2.Cells(sat, 6).Value = s1.Cells(r, 5).Value

s2.Cells(sat, 7).Value = s1.Cells(r, 8).Value
s2.Cells(sat, 8).Value = s1.Cells(r, 9).Value
s2.Cells(sat, 9).Value = s1.Cells(r, 10).Value
If s1.Cells(r, 11).Value <> "" Then
s2.Cells(sat, 10).Value = CDate(s1.Cells(r, 11).Value)
End If
s2.Cells(sat, 11).Value = s1.Cells(r, 12).Value
s2.Cells(sat, 12).Value = s1.Cells(r, 13).Value
s2.Cells(sat, 13).Value = s1.Cells(r, 14).Value
If s1.Cells(r, 15).Value <> "" Then
s2.Cells(sat, 14).Value = CDate(s1.Cells(r, 15).Value)
End If

sat = sat + 1
End If
End If

End If

Next r

s2.Range("B6:Q33").Sort Key1:=s2.Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MsgBox " Düzenleme Tamanlanmıştır..."
End Sub

Kod:
Sub aktar2()
Dim s1, s2
Set s1 = Sheets("TÜM LİSTE")
Set s2 = Sheets("AYLIK TERFİSİ GELENLER")
ay = s1.Cells(1, "G").Value
Tarih = Val(Format("01." & Format(ay, "00") & "." & Format(Format(Now, "yyyy"), "0000"), "mm"))

s2.Range("A6:Q65536").ClearContents
s1.Range("A3:O500").Interior.ColorIndex = xlNone
s1.Range("A3:O500").Font.ColorIndex = 0
sat = 6

For r = 3 To s1.[f65536].End(3).Row

If s1.Cells(r, "o").Value <> "" Then
aranan = CDate(s1.Cells(r, "o").Value)

s1.Cells(r, "o").Value = CDate(s1.Cells(r, "o").Value)

If Val(Format(aranan, "dd")) <= 14 Then

If Val(Format(aranan, "mm")) = Tarih Then

s1.Range("A" & r & ":O" & r).Interior.ColorIndex = 15
s1.Range("A" & r & ":O" & r).Font.ColorIndex = 5

s2.Cells(sat, 1).Value = sat - 5
s2.Cells(sat, 2).Value = s1.Cells(r, 4).Value
s2.Cells(sat, 3).Value = s1.Cells(r, 3).Value
s2.Cells(sat, 4).Value = s1.Cells(r, 6).Value
s2.Cells(sat, 5).Value = s1.Cells(r, 7).Value
s2.Cells(sat, 6).Value = s1.Cells(r, 5).Value


s2.Cells(sat, 7).Value = s1.Cells(r, 8).Value
s2.Cells(sat, 8).Value = s1.Cells(r, 9).Value
s2.Cells(sat, 9).Value = s1.Cells(r, 10).Value
If s1.Cells(r, 11).Value <> "" Then
s2.Cells(sat, 10).Value = CDate(s1.Cells(r, 11).Value)
End If
s2.Cells(sat, 11).Value = s1.Cells(r, 12).Value
s2.Cells(sat, 12).Value = s1.Cells(r, 13).Value
s2.Cells(sat, 13).Value = s1.Cells(r, 14).Value
If s1.Cells(r, 15).Value <> "" Then
s2.Cells(sat, 14).Value = CDate(s1.Cells(r, 15).Value)

End If

sat = sat + 1
End If
End If
If Tarih = 1 Then
ser = 12
Else
ser = 0
End If

If Val(Mid(aranan, 1, 2)) > 14 Then
If Val(Mid(aranan, 4, 2)) = Tarih - 1 + ser Then
s1.Range("A" & r & ":O" & r).Interior.ColorIndex = 15
s1.Range("A" & r & ":O" & r).Font.ColorIndex = 5
s2.Cells(sat, 1).Value = sat - 5
s2.Cells(sat, 2).Value = s1.Cells(r, 4).Value
s2.Cells(sat, 3).Value = s1.Cells(r, 3).Value
s2.Cells(sat, 4).Value = s1.Cells(r, 6).Value
s2.Cells(sat, 5).Value = s1.Cells(r, 7).Value
s2.Cells(sat, 6).Value = s1.Cells(r, 5).Value

s2.Cells(sat, 7).Value = s1.Cells(r, 8).Value
s2.Cells(sat, 8).Value = s1.Cells(r, 9).Value
s2.Cells(sat, 9).Value = s1.Cells(r, 10).Value
If s1.Cells(r, 11).Value <> "" Then
s2.Cells(sat, 10).Value = CDate(s1.Cells(r, 11).Value)
End If
s2.Cells(sat, 11).Value = s1.Cells(r, 12).Value
s2.Cells(sat, 12).Value = s1.Cells(r, 13).Value
s2.Cells(sat, 13).Value = s1.Cells(r, 14).Value
If s1.Cells(r, 15).Value <> "" Then
s2.Cells(sat, 14).Value = CDate(s1.Cells(r, 15).Value)
End If

sat = sat + 1
End If
End If


End If

Next r
s2.Range("B6:Q33").Sort Key1:=s2.Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MsgBox " Düzenleme Tamanlanmıştır..."
End Sub
 
Hem Halit abime hem de turist abime yapmış oldukları yardım için sonsuz teşekkür ederim.
Allah sizlerden razı olsun. ellerinize sağlık.
 
Halit abi;
Aktar1 makrosunda
aranan = CDate(s1.Cells(r, "k").Value)
Aktar2 makrosunda da
aranan = CDate(s1.Cells(r, "o").Value)
satırı hata veriyor.
Bakabilmeniz mümkün mü?
 
Halit abi;
Aktar1 makrosunda
aranan = CDate(s1.Cells(r, "k").Value)
Aktar2 makrosunda da
aranan = CDate(s1.Cells(r, "o").Value)
satırı hata veriyor.
Bakabilmeniz mümkün mü?

1 nolu mesajdaki linkdeki dosyada kodlar çalışıyor.

K ve O sütunlarında tarih olmalıdır.
 
Aynı şekilde

O200 satırda bu var (29.02.2013)

Bu tarih yanlış doğrusu (28.02.2013) bu olmalı onun için dosyanızda hata alıyorsunuz.
 
Halit abi ellerinden öperim.
Hakkını helal et. Dediğiniz satırı değiştirdim. İşlem tamamlandı.
Allah razı olsun.
 
karışıklık yok kodlar şu işlemi yapıyor
1-14 günü ilgili aya terfi yapıyor
15-30 veya 31 diğer aya yapıyor

örnek1 13.03.2014 tarihini mart ayı olarak yapıyor
örnek2 16.03.2014 tarihini nisan ayı olarak yapıyor.

Maaş uygulamalarında terfiler bu şekilde yapılıyor.
 
Bunu istiyorsunuz herhalde

Kod:
Sub aktar1()

Dim s1, s2
Set s1 = Sheets("TÜM LİSTE")
Set s2 = Sheets("AYLIK TERFİSİ GELENLER")
ay = s1.Cells(1, "G").Value
Tarih = Val(Format("01." & Format(ay, "00") & "." & Format(Format(Now, "yyyy"), "0000"), "mm"))

s2.Range("A6:Q65536").ClearContents
s1.Range("A3:O500").Interior.ColorIndex = xlNone
s1.Range("A3:O500").Font.ColorIndex = 0

sat = 6

For r = 3 To s1.[f65536].End(3).Row
If s1.Cells(r, "k").Value <> "" Then
aranan = CDate(s1.Cells(r, "k").Value)

s1.Cells(r, "k").Value = CDate(s1.Cells(r, "k").Value)

If Val(Format(aranan, "mm")) = Tarih Then

s1.Range("A" & r & ":O" & r).Interior.ColorIndex = 15
s1.Range("A" & r & ":O" & r).Font.ColorIndex = 5


s2.Cells(sat, 1).Value = sat - 5
s2.Cells(sat, 2).Value = s1.Cells(r, 4).Value
s2.Cells(sat, 3).Value = s1.Cells(r, 3).Value
s2.Cells(sat, 4).Value = s1.Cells(r, 6).Value
s2.Cells(sat, 5).Value = s1.Cells(r, 7).Value
s2.Cells(sat, 6).Value = s1.Cells(r, 5).Value


s2.Cells(sat, 7).Value = s1.Cells(r, 8).Value
s2.Cells(sat, 8).Value = s1.Cells(r, 9).Value
s2.Cells(sat, 9).Value = s1.Cells(r, 10).Value
If s1.Cells(r, 11).Value <> "" Then
s2.Cells(sat, 10).Value = CDate(s1.Cells(r, 11).Value)
End If
s2.Cells(sat, 11).Value = s1.Cells(r, 12).Value
s2.Cells(sat, 12).Value = s1.Cells(r, 13).Value
s2.Cells(sat, 13).Value = s1.Cells(r, 14).Value

If s1.Cells(r, 15).Value <> "" Then
s2.Cells(sat, 14).Value = CDate(s1.Cells(r, 15).Value)
End If
sat = sat + 1
End If
End If
Next r

s2.Range("B6:Q33").Sort Key1:=s2.Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MsgBox " Düzenleme Tamanlanmıştır..."
End Sub

Kod:
Sub aktar2()
Dim s1, s2
Set s1 = Sheets("TÜM LİSTE")
Set s2 = Sheets("AYLIK TERFİSİ GELENLER")
ay = s1.Cells(1, "G").Value
Tarih = Val(Format("01." & Format(ay, "00") & "." & Format(Format(Now, "yyyy"), "0000"), "mm"))

s2.Range("A6:Q65536").ClearContents
s1.Range("A3:O500").Interior.ColorIndex = xlNone
s1.Range("A3:O500").Font.ColorIndex = 0
sat = 6

For r = 3 To s1.[f65536].End(3).Row

If s1.Cells(r, "o").Value <> "" Then
aranan = CDate(s1.Cells(r, "o").Value)

s1.Cells(r, "o").Value = CDate(s1.Cells(r, "o").Value)

If Val(Format(aranan, "mm")) = Tarih Then

s1.Range("A" & r & ":O" & r).Interior.ColorIndex = 15
s1.Range("A" & r & ":O" & r).Font.ColorIndex = 5

s2.Cells(sat, 1).Value = sat - 5
s2.Cells(sat, 2).Value = s1.Cells(r, 4).Value
s2.Cells(sat, 3).Value = s1.Cells(r, 3).Value
s2.Cells(sat, 4).Value = s1.Cells(r, 6).Value
s2.Cells(sat, 5).Value = s1.Cells(r, 7).Value
s2.Cells(sat, 6).Value = s1.Cells(r, 5).Value


s2.Cells(sat, 7).Value = s1.Cells(r, 8).Value
s2.Cells(sat, 8).Value = s1.Cells(r, 9).Value
s2.Cells(sat, 9).Value = s1.Cells(r, 10).Value
If s1.Cells(r, 11).Value <> "" Then
s2.Cells(sat, 10).Value = CDate(s1.Cells(r, 11).Value)
End If
s2.Cells(sat, 11).Value = s1.Cells(r, 12).Value
s2.Cells(sat, 12).Value = s1.Cells(r, 13).Value
s2.Cells(sat, 13).Value = s1.Cells(r, 14).Value

If s1.Cells(r, 15).Value <> "" Then
s2.Cells(sat, 14).Value = CDate(s1.Cells(r, 15).Value)
End If

sat = sat + 1
End If


End If

Next r
s2.Range("B6:Q33").Sort Key1:=s2.Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MsgBox " Düzenleme Tamanlanmıştır..."
End Sub
 
Halit abi dediğinize gözüm kapalı inanıyorum hem de şüphesiz. Ancak ilgili bölüm şefim
derece ya da kademe dediğim zaman örneğin şubat ayı ise sadece şubat ayları gelsin diğer aylar gelmesin dediği için tekrar size dönmek zorunda kaldım. Bu sebeple Derece makrosu için sadece ilgili ay ve derece terfiler gelsin Kademe makrosu için sadece ilgili ay ve kademe terfiler gelsin şeklinde bir yazı yazmak zorunda kaldım.
Halit abi;
Hakkını helal et. Büyüklüğüne sığınarak yukarıda arz ettiğim gibi düzenleme yapabilmeniz mümkün mü?
 
Halit abi;
Sub aktar1()
yeni terfisi yani kademesi 3 olanları da aktarıyor.
bunu aktarmasını engelleyebilir miyiz?
Sub aktar2()
yeni terfisi yani kademesi 1 olanları da aktarıyor.
bunu aktarmasını engelleyebilir miyiz?
 
Halit abi;
Sub aktar1()
yeni terfisi yani kademesi 3 olanları da aktarıyor.
bunu aktarmasını engelleyebilir miyiz?
Sub aktar2()
yeni terfisi yani kademesi 1 olanları da aktarıyor.
bunu aktarmasını engelleyebilir miyiz?

Buradaki kodlar derece ve kademeye bakmaz sadece ilgili aya ait aktarmaları yapar.

Yani derece ve kademe ilerlemesi yapmaz.
 
Geri
Üst