Araç Servis Takip Programı (AST-v.2) foruma eklenmiştir. 
http://www.excelce.net/forum/index.php?topic=1656.0

Gönderen Konu: Personel puantaj icmali oluşturma  (Okunma sayısı 5286 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı muzo696

  • Excelce Onbaşı
  • **
  • İleti: 2
  • Puan +0/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
  • Ad Soyad: AHMET ÇELİK
  • Doğum Yılınız: 1986
  • İl / İlçe: VAN
  • İşletim Sisteminiz: WİNDOS 7
  • Mesleğiniz: MEMUR
  • Office Versiyonunuz: 2010
Personel puantaj icmali oluşturma
« : 01 Şubat 2016, 15:53:26 »
Arkadaşlar öncelikle bu forumdaki arkadaşların yardımlarından dolayı çok tesekkur ederım.. Yuklemıs olduğum dosyada personellerin izinliler raporlular sayfasında personellerin verilerini, başlama ve bitiş tarihlerini girip bu listedeki isimlerin icmal sayfasına otomatik gecmesini ve günler kısmında çentiklerin silinerek boyanmasını istiyorum tam olarak.Bu konuda yardımcı olmak ısteyen hocalarım oldu kod paylastılar ancak şablon biraz değişti ve son şablonum bu. Ekleyeceğim kodları bu şablona göre yapmak istediklerimi ayarlayabilecek arkadaşım olursa çok sevinirim.. şimdiden çok teşekkür ederim.
.

http://s8.dosya.tc/server/dkewsb/PER...ANTAJ.xls.html

ESKİ ŞABLONUN KODLARI

Sub ÇENTİK_SİL_BRN()
Dim n, i As Worksheet
Set n = Sheets("NÖBET")
Set i = Sheets("İCMAL")
For brn = 2 To n.[F65536].End(3).Row
If n.[E65536].End(3).Row <> n.[F65536].End(3).Row Or n.[B65536].End(3).Row <> n.[E65536].End(3).Row Then GoTo 10
If WorksheetFunction.CountIf(i.Range("B:B"), n.Cells(brn, 2)) = 0 Or n.Cells(brn, 2) = "" Then GoTo 10
brnsat = WorksheetFunction.Match(n.Cells(brn, 2), i.Range("B:B"), 0)
m = Len(n.Cells(brn, 5))
If m = 10 Then
ilksut = Day(n.Cells(brn, 5)) + 4
sonsut = Day(n.Cells(brn, 6)) + 3
GoTo 5
Else
a = Mid(n.Cells(brn, "E"), 1, 10)
b = Mid(n.Cells(brn, "F"), 1, 10)
c = Mid(n.Cells(brn, "E"), 12, 10)
d = Mid(n.Cells(brn, "F"), 12, 10)
ilksut = Day(a) + 4
sonsut = Day(b) + 3
ilksut1 = Day(c) + 4
sonsut1 = Day(d) + 3
i.Range(i.Cells(brnsat, ilksut), i.Cells(brnsat, sonsut)) = ""
i.Range(i.Cells(brnsat, ilksut1), i.Cells(brnsat, sonsut1)) = ""
i.Range(i.Cells(brnsat, ilksut), i.Cells(brnsat, sonsut)).Interior.ColorIndex = 27
i.Range(i.Cells(brnsat, ilksut1), i.Cells(brnsat, sonsut1)).Interior.ColorIndex = 27
GoTo 10
End If
5: i.Range(i.Cells(brnsat, ilksut), i.Cells(brnsat, sonsut)) = ""
i.Range(i.Cells(brnsat, ilksut), i.Cells(brnsat, sonsut)).Interior.ColorIndex = 27
10: Next
MsgBox "ÇENTİKLER KALDIRILDI"
End Sub,

Bu kodlar eski şablonda benim isteğimi karşılıyordu ancak sadece çentikleri boyamıyordu.
Bu kodları yeni şablona düzenleyecek arkadaşıma minnettar olurum..