Devamsızlık Çizelgesi

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu kodu bir dene Ancak Ay isimlerini böyle yazmalısınız. Ocak ,Şubat,Mart,Nisan gibi


Kod:
Sub deneme()

Range("B14:P44").ClearContents
Range("B14:P44").Interior.ColorIndex = xlNone

sat = 14

hucre = Val(Worksheets(ActiveSheet.Name).Cells(6, "D").Value)
zaman = CDate(Format("01.01." & hucre, "dd.mm.yyyy"))

Dim M As Date
For i = 0 To 367
M = zaman + i

If Val(Format((M), "yyyy")) = hucre Then

If Format((M), "mmmm") = Worksheets(ActiveSheet.Name).Cells(6, "L").Value Then
If Format((M), "dddd") = "Pazar" Or Format((M), "dddd") = "Cumartesi" Then
Range("C" & sat & ":D" & sat).Interior.ColorIndex = 6
Range("G" & sat & ":H" & sat).Interior.ColorIndex = 6
Range("K" & sat & ":L" & sat).Interior.ColorIndex = 6
Range("O" & sat & ":P" & sat).Interior.ColorIndex = 6


Else
End If

Cells(sat, "b") = sat - 13
Cells(sat, "f") = sat - 13
Cells(sat, "j") = sat - 13
Cells(sat, "n") = sat - 13
sat = sat + 1
End If
End If
Next i


End Sub
 
Son düzenleme:
Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
Bu kodu bir dene Ancak Ay isimlerini böyle yazmalısınız. Ocak ,Şubat,Mart,Nisan gibi

Kod:
Sub deneme()

Range("C14:D44").Interior.ColorIndex = xlNone
Range("G14:H44").Interior.ColorIndex = xlNone
Range("K14:L44").Interior.ColorIndex = xlNone
Range("O14:P44").Interior.ColorIndex = xlNone

sat = 14

hucre = Val(Worksheets(ActiveSheet.Name).Cells(6, "D").Value)
zaman = CDate(Format("01.01." & hucre, "dd.mm.yyyy"))

Dim M As Date
For i = 0 To 367
M = zaman + i

If Val(Format((M), "yyyy")) = hucre Then

If Format((M), "mmmm") = Worksheets(ActiveSheet.Name).Cells(6, "L").Value Then
If Format((M), "dddd") = "Pazar" Or Format((M), "dddd") = "Cumartesi" Then
Range("C" & sat & ":D" & sat).Interior.ColorIndex = 6
Range("G" & sat & ":H" & sat).Interior.ColorIndex = 6
Range("K" & sat & ":L" & sat).Interior.ColorIndex = 6
Range("O" & sat & ":P" & sat).Interior.ColorIndex = 6
Else
End If
sat = sat + 1
End If
End If
Next i


End Sub
Halit bey denedim olmadı . Dosya ekte. zahmet olmazsa bakabilirmisiniz.
 

Ekli dosyalar

Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
Selsamlar

Dosyayı inceler misiniz
İyi çalışmalar 31 çeken aylarda sorun yok 30 çeken aylarda 30 dan sonra 01 yazıyor boş olması gerekirken. Cumartesi ve Pazar günleride yazılı olarak çıkabilir mi acaba . ilginiz için çok teşekkür ederim.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
koda kırmızı bölümü ekledim.

Rich (BB code):
Sub deneme()


Range("B14:P44").ClearContents
Range("B14:P44").Interior.ColorIndex = xlNone

sat = 14

hucre = Val(Worksheets(ActiveSheet.Name).Cells(6, "D").Value)
zaman = CDate(Format("01.01." & hucre, "dd.mm.yyyy"))

Dim M As Date
For i = 0 To 367
M = zaman + i

If Val(Format((M), "yyyy")) = hucre Then

If Format((M), "mmmm") = Worksheets(ActiveSheet.Name).Cells(6, "L").Value Then
If Format((M), "dddd") = "Pazar" Or Format((M), "dddd") = "Cumartesi" Then
Range("C" & sat & ":D" & sat).Interior.ColorIndex = 6
Range("G" & sat & ":H" & sat).Interior.ColorIndex = 6
Range("K" & sat & ":L" & sat).Interior.ColorIndex = 6
Range("O" & sat & ":P" & sat).Interior.ColorIndex = 6

Range("C" & sat & ":D" & sat).Value = Format((M), "dddd")
Range("G" & sat & ":H" & sat).Value = Format((M), "dddd")
Range("K" & sat & ":L" & sat).Value = Format((M), "dddd")
Range("O" & sat & ":P" & sat).Value = Format((M), "dddd")


Else
End If

Cells(sat, "b") = sat - 13
Cells(sat, "f") = sat - 13
Cells(sat, "j") = sat - 13
Cells(sat, "n") = sat - 13
sat = sat + 1
End If
End If
Next i


End Sub
 
Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
koda kırmızı bölümü ekledim.

Rich (BB code):
Sub deneme()


Range("B14:P44").ClearContents
Range("B14:P44").Interior.ColorIndex = xlNone

sat = 14

hucre = Val(Worksheets(ActiveSheet.Name).Cells(6, "D").Value)
zaman = CDate(Format("01.01." & hucre, "dd.mm.yyyy"))

Dim M As Date
For i = 0 To 367
M = zaman + i

If Val(Format((M), "yyyy")) = hucre Then

If Format((M), "mmmm") = Worksheets(ActiveSheet.Name).Cells(6, "L").Value Then
If Format((M), "dddd") = "Pazar" Or Format((M), "dddd") = "Cumartesi" Then
Range("C" & sat & ":D" & sat).Interior.ColorIndex = 6
Range("G" & sat & ":H" & sat).Interior.ColorIndex = 6
Range("K" & sat & ":L" & sat).Interior.ColorIndex = 6
Range("O" & sat & ":P" & sat).Interior.ColorIndex = 6

Range("C" & sat & ":D" & sat).Value = Format((M), "dddd")
Range("G" & sat & ":H" & sat).Value = Format((M), "dddd")
Range("K" & sat & ":L" & sat).Value = Format((M), "dddd")
Range("O" & sat & ":P" & sat).Value = Format((M), "dddd")


Else
End If

Cells(sat, "b") = sat - 13
Cells(sat, "f") = sat - 13
Cells(sat, "j") = sat - 13
Cells(sat, "n") = sat - 13
sat = sat + 1
End If
End If
Next i


End Sub
Emeğinize sağlık halit bey çok teşekkür ederim ilgi ve alakanız için.
 
Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
Emeğinize sağlık halit bey çok teşekkür ederim ilgi ve alakanız için.
Arkadaşlar iyi akşamlar. Devamsızlık Çizelgesinin İlk Bölümü yardımlarınız sayesinde oldu. ikinci aşamayı atlatırsam inşallah güzel bir çalışma olacak. 700 kadar personelim var bunları ad soyad ve TC numaraları Devamsızlık çizelgesine aktarıp yazdırmam gerekiyor acaba nasıl bir çalışma yapabilriz. Yardımlarınızı bekliyorum. Sorun çözülürse çok memenun olurum.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Kod

Kod:
Sub yazdır()

sayf1 = "Sayfa1"
sayf2 = "Sayfa2"

Worksheets(sayf1).Range("C11").Value = ""
Worksheets(sayf1).Range("C12").Value = ""
Worksheets(sayf1).Range("G11").Value = ""
Worksheets(sayf1).Range("G12").Value = ""
Worksheets(sayf1).Range("K11").Value = ""
Worksheets(sayf1).Range("K12").Value = ""
Worksheets(sayf1).Range("O11").Value = ""
Worksheets(sayf1).Range("O12").Value = ""

For r = 1 To Worksheets(sayf2).Cells(Rows.Count, "A").End(3).Row Step 4
Worksheets(sayf1).Range("C11").Value = Worksheets(sayf2).Cells(r, 1).Value
Worksheets(sayf1).Range("C12").Value = Worksheets(sayf2).Cells(r, 2).Value
Worksheets(sayf1).Range("G11").Value = Worksheets(sayf2).Cells(r + 1, 1).Value
Worksheets(sayf1).Range("G12").Value = Worksheets(sayf2).Cells(r + 1, 2).Value
Worksheets(sayf1).Range("K11").Value = Worksheets(sayf2).Cells(r + 2, 1).Value
Worksheets(sayf1).Range("K12").Value = Worksheets(sayf2).Cells(r + 2, 2).Value
Worksheets(sayf1).Range("O11").Value = Worksheets(sayf2).Cells(r + 3, 1).Value
Worksheets(sayf1).Range("O12").Value = Worksheets(sayf2).Cells(r + 3, 2).Value
ActiveWindow.SelectedSheets.PrintOut
Next r

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

End Sub
 
Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
Kod

Kod:
Sub yazdır()

sayf1 = "Sayfa1"
sayf2 = "Sayfa2"

Worksheets(sayf1).Range("C11").Value = ""
Worksheets(sayf1).Range("C12").Value = ""
Worksheets(sayf1).Range("G11").Value = ""
Worksheets(sayf1).Range("G12").Value = ""
Worksheets(sayf1).Range("K11").Value = ""
Worksheets(sayf1).Range("K12").Value = ""
Worksheets(sayf1).Range("O11").Value = ""
Worksheets(sayf1).Range("O12").Value = ""

For r = 1 To Worksheets(sayf2).Cells(Rows.Count, "A").End(3).Row Step 4
Worksheets(sayf1).Range("C11").Value = Worksheets(sayf2).Cells(r, 1).Value
Worksheets(sayf1).Range("C12").Value = Worksheets(sayf2).Cells(r, 2).Value
Worksheets(sayf1).Range("G11").Value = Worksheets(sayf2).Cells(r + 1, 1).Value
Worksheets(sayf1).Range("G12").Value = Worksheets(sayf2).Cells(r + 1, 2).Value
Worksheets(sayf1).Range("K11").Value = Worksheets(sayf2).Cells(r + 2, 1).Value
Worksheets(sayf1).Range("K12").Value = Worksheets(sayf2).Cells(r + 2, 2).Value
Worksheets(sayf1).Range("O11").Value = Worksheets(sayf2).Cells(r + 3, 1).Value
Worksheets(sayf1).Range("O12").Value = Worksheets(sayf2).Cells(r + 3, 2).Value
ActiveWindow.SelectedSheets.PrintOut
Next r

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

End Sub
Sayın Halit bey böyle bir şeyin olacağını bu kadar kısa zamanda bu kadar güzel sorun çözülür. Çok teşekkür ederim. Emeğinize sağlık. Siz yardımsever arkadaşlar hepinizden ALLAH razı olsun
 
Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
Sayın Halit bey böyle bir şeyin olacağını bu kadar kısa zamanda bu kadar güzel sorun çözülür. Çok teşekkür ederim. Emeğinize sağlık. Siz yardımsever arkadaşlar hepinizden ALLAH razı olsun
İyi günler iyi çalışmalar arkadaşlar. Öncelikle bu devamsızlık çizelgesinde bana çok yardımcı olan çizelgenin bu hale gelmesinde emeği olan Halit3 hocama çok teşekkür ederim. Devamsızlık çizelgesi gerçekten çok güzel oldu. İnanıyorumki İŞKUR personeli olan tüm arkadaşlar bundan faydalanacaktır. Emeği geçenlere dua edeceklerdir. Benim düşünceme göre anladığım kadarıyla bir eksiklik kaldı ama geliştirmek isteyen arkadaşlar yardımcı olabilirler. Çünkü bu konu sadece bana lazım olmayacak. Mutlaka faydalanacak arkadaşlar olacaktır. Benim sorunuma gelince Halit3 hocamın yaptığı değişikliklerden sonra sayfa3 te bulunan gruplardan örneğin sadece 3. gruptakileri kopyalama yapmadan sayfa2 ye nasıl alabiliriz. Yardımcı olursanız çok memnun olurum. Dosya ektedir.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Sayfa2 F1 hücresine aranan değeri yaz ve bu kodu çalıştır.

Kod:
Sub aktar()

Set s1 = Sheets("Sayfa2")
Set s2 = Sheets("Sayfa3") ' veri sayfası

s1.Range("a1:c" & Rows.Count).ClearContents
aranan = s1.Cells(1, "f").Value
sat = 1
For i = 1 To s2.Cells(Rows.Count, "A").End(3).Row
If s2.Cells(i, 3).Value = aranan Then
s1.Cells(sat, 1).Value = s2.Cells(i, 1).Value
s1.Cells(sat, 2).Value = s2.Cells(i, 2).Value
s1.Cells(sat, 3).Value = s2.Cells(i, 3).Value
sat = sat + 1
End If

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

End Sub
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu dosyada sayfa2 de (G sutununa diz) komut duğmesine tıkla sonra F1 hücresinden makam seç sonrada (aktar) düğmesine tıkla
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Kodların hepsini birleştirdim
sayfa3 de sildim

ilk dosyanız gibi sayfa1 ve sayfa2 var sadece
 

Ekli dosyalar

Katılım
1 Ekim 2017
Mesajlar
685
Excel Vers. ve Dili
2019 türkçe
Halit3 hocam çok teşekkür ederim.Çok iyi oldu temiz ve sade.[/QUOTEM
Merhaba hocam Devamsızlık çizelgesini 2. sayfasında kurumların olduğu yerde kurum sayısı fazla oldu. sayfa1 deki ı1 deki kurumlar 500. sıradan sonra görünmüyor 500. sıradan sonrasının görünmesi mümkünmü
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Ad tanımlamadan isim (isim) bölümünü bul
=Sayfa2!$C$1:$C$500 beş yüz yazan yeri çoğalt
 
Üst