• DİKKAT

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

Devamsızlık Çizelgesi

S

sedat2161

Katılım
1 Ekim 2017
Mesajlar
694
Excel Vers. ve Dili
2019 türkçe
Arkadaşlar hayırlı Günler. Ekte gönderdiğim Devamsızlık çizelgesinde L6 hücresine ayı yazdığımda çizelgede cumartesi pazar günlerinin otomatik olarak alması mümkünmü acaba. İyi çalışmalar dilerim.
 

Ekli dosyalar

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:
halit3' Alıntı:
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
Genişletmek için tıkla ...
Halit bey denedim olmadı . Dosya ekte. zahmet olmazsa bakabilirmisiniz.
 

Ekli dosyalar

Mdemir63' Alıntı:
Selsamlar

Dosyayı inceler misiniz
Genişletmek için tıkla ...
İ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.
 
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
 
halit3' Alıntı:
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
Genişletmek için tıkla ...
Emeğinize sağlık halit bey çok teşekkür ederim ilgi ve alakanız için.
 
sedat2161' Alıntı:
Emeğinize sağlık halit bey çok teşekkür ederim ilgi ve alakanız için.
Genişletmek için tıkla ...
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

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
 
halit3' Alıntı:
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
Genişletmek için tıkla ...
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
 
sedat2161' Alıntı:
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
Genişletmek için tıkla ...
İ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

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

  • SSS.xls
    SSS.xls
    101 KB · Görüntüleme: 6
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

Kodların hepsini birleştirdim
sayfa3 de sildim

ilk dosyanız gibi sayfa1 ve sayfa2 var sadece
 

Ekli dosyalar

sedat2161' Alıntı:
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ü
Genişletmek için tıkla ...
 

Ekli dosyalar

Ad tanımlamadan isim (isim) bölümünü bul
=Sayfa2!$C$1:$C$500 beş yüz yazan yeri çoğalt
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst