Çözüldü Puantaj Çalışması Tarih Problemi

[selcuk23]

Mrh. Bir çalışma sayfasına girilecek her türlü tarih aralıklarındaki işareti / işaretine çevirecek bir kod ihtiyacım var.Mesela ben 12.02.2018 veya 12,02,2018 gibi farklı işaretler olarak girdiğim tarihi 12/02/2018 olarak kaydetsin. Yardımcı olurmusunuz.

 

[İdris SERDAR]

Tarih girilecek alanları;

gg/aa/yyyy;@

şeklinde biçimlendirin.

.

 

[selcuk23]

Mrh. Makro ile işlem yaptığım bir çalışma sayfam var. Bu çalışma sayfasında tarihler 01/01/2018 şeklinde olmazsa makrolar tarihleri (örn;01.01.2018) görmüyor. İdris Bey dediğiniz şekilde yaptım ama bazı hücredeki tarihler değişmedi. Ayrıca her nekadar dediğiniz yöntem tarihleri 01/01/2018 şekline çevirse de hücre içine tıkladığımda hala tarihler noktalı şekilde görünüyor..Acaba kullandığım kod buna engel mi oluyor.

Sub puantaj()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

On Local Error Resume Next
Set s1 = Sheets("PUANTAJ")
Set s2 = Sheets("PERSONEL LİSTESİ")
Set s3 = Sheets("VARDİYA NÖBET CİZELGESİ")
Set s4 = Sheets("izin takip")

dönem = s1.[a1]
uyarı = MsgBox(s1.[B5] & " işlensin mi?" & Chr(10) & _
        "Vardiya çizelgesini ve personel listesini hazırladınız mı?", vbYesNo)
If uyarı = vbYes Then
    sonkişi = WorksheetFunction.Max(7, s1.Cells(Rows.Count, "A").End(3).Row)
    songün = WorksheetFunction.Max(2, s3.Cells(Rows.Count, "B").End(3).Row)
    sonpersonel = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
    
    s1.Range("A7:AJ" & sonkişi).Clear
    
    s2.Range("A2:D" & sonpersonel).Copy: s1.[A7].PasteSpecial Paste:=xlPasteValues
    son = s1.Cells(Rows.Count, "A").End(3).Row

    For kişi = 7 To son
        For gün = 5 To 35
            If s1.Cells(2, gün) <> "" Then
                If s1.Cells(kişi, "D") = "SABİT" Then
                    If WorksheetFunction.Weekday(s1.Cells(6, gün), 2) <= 5 Then
                        s1.Cells(kişi, gün) = "X"
                    End If
                ElseIf s1.Cells(kişi, "D") = s1.Cells(1, gün) Or s1.Cells(kişi, "D") = s1.Cells(2, gün) Then
                    s1.Cells(kişi, gün) = "X"
                End If
            End If
        Next
        s1.Cells(kişi, "AJ").FormulaR1C1 = "=IF(RC[-32]=""SABİT"",COUNTIF(RC[-31]:RC[-1],""X""),IF(MOD(COUNTIF(RC[-31]:RC[-1],""X""),2)=1,(((COUNTIF(RC[-31]:RC[-1],""X"")-QUOTIENT(COUNTIF(RC[-31]:RC[-1],""X""),2))*10.5)+(QUOTIENT(COUNTIF(RC[-31]:RC[-1],""X""),2)*13.5))/8,(((COUNTIF(RC[-31]:RC[-1],""X"")/2)*10.5)+((COUNTIF(RC[-31]:RC[-1],""X"")/2)*13.5))/8))"
    Next
End If
Application.CutCopyMode = False

    With s1.Range("A7:AJ" & son).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With s1.Range("A7:AJ" & son).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Range("A7:D" & son).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Range("A7:D" & son).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Range("AJ7:AJ" & son).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("AJ7:AJ" & son).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("AJ7:AJ" & son).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("AJ7:AJ" & son).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    With Range("A7:AJ" & son).Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("AJ7:AJ" & son).Font.Bold = True
    
    Range("E6:AJ" & son).FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=HAFTANINGÜNÜ(E$6;2)>5" ' satır toplamları
    Range("E6:AJ" & son).FormatConditions(Range("E6:AJ" & son).FormatConditions.Count).SetFirstPriority
    With Range("E6:AJ" & son).FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Range("E6:AJ" & son).FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249946592608417
    End With
    Range("E6:AJ" & son).FormatConditions(1).StopIfTrue = False

    With Range("E7:AJ" & son)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("A7:D" & son)
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("A7:A" & son)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    'İzin vs işleme
    sonizin = s4.Cells(Rows.Count, "A").End(3).Row
    For m = 7 To son
        If WorksheetFunction.CountIf(s4.Range("A1:A" & sonizin), s1.Cells(m, "B")) >= 1 Then
            For n = 2 To sonizin
                If s4.Cells(n, "A") = s1.Cells(m, "B") Then
                    For o = 5 To 35
                        If s1.Cells(6, o) <> "" Then
                            If s1.Cells(6, o) >= s4.Cells(n, "B") And s1.Cells(6, o) < s4.Cells(n, "C") Then
                                s1.Cells(m, o) = s4.Cells(n, "E")
                                s1.Cells(m, o).Interior.Color = 16776360
                            End If
                        End If
                    Next
                End If
            Next
        End If
    Next
     With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
MsgBox "İşlem tamamlandı"
End Sub

Acaba bu Noktalı veya farklı formattaki tarihleri okuması için bu kodda bir değişiklik yapılabilirmi

 

[selcuk23]

Güncell

 

[netzone]

Merhaba,

Windows tarih formatını değiştirmeniz işinizi görecek gibi. Bunu excel dosyanız açıldığında değiştirip kapanırken eski haline gelmesi için bir çözüm yolu bulunabilir mi (Kod bilgim yetersiz olduğundan) emin değilim. Forumda yaptığım arama sonucu bir konuya rastladım: paylaşımda verilen linklere bir göz atın işinizi görebilir.

iyi çalışmalar.

 

[selcuk23]

Merhaba konuyu yeniden açıyorum ekte izin takip sayfasına açıklamayı yazdım. Yardımcı olurmusunuz http://s7.dosya.tc/server9/n39yjb/PUANTAJ_0_-_Kopya.rar.html

 

[Ömer BARAN]

Merhaba.

Belgedeki kodlarda, izin takip sayfası B ve C sütununa tarihleri yazan bir kod göremedim.
Yoksa bu tarihler elle mi yazılıyor acaba?
Eğer elle yazılıyorsa; B ve C sütunlarını TARİH olarak biçimlendirdikten sonra verileri yazarak deneyiniz.
Örneğin PUANTAJ sayfasında boş bir hücreye
=V6='izin takip'!B7 formülünü yazarsanız izin takip sayfasındaki verinin tarih olmadığı (formülün sonucu YANLIŞ) daha iyi anlaşılacaktır.
izin takip sayfasında, B ve C sütunlarındaki hücreler için tek tek F2>>ENTER işlemi yapılınca tarihe dönüşüyor ve
yukarıdaki formül DOĞRU sonucunu veriyor.

Bir seçenek de B ve C sütunundaki verilerin başka kaynaktan kopyala yapıştır yöntemiyle yapılıyor olması.
Belgediki durum hangisidir acaba?
.

 

[selcuk23]

Hocam izin takipte bir kod yok. Puantaj sayfasındaki kodlar izin takipteki tarihleri çekiyor. puantaj sayfasındaki kodda yapılacak bir düzenleme ile izin takipteki noktalı tarih formatlı izinleri puantaja işlemesini istiyorum.. sorun kısaca şöyle tarif edebilirim.. izin takipteki tarihi(15/05/2018 seklinde yazarsam puantaja izinleri işliyor ancak tarih aralığı noktalı olursa 15.05.2018 şeklinde olursa işlemiyor)

 

[Ömer BARAN]

Tekrar merhaba.

Aslında düzenlemeyi verileri aldığınız kaynakta yapmak bence daha doğru ama çözüm aşağıda.

puantaj isimli makrodaki ilgili satırı aşağıdakiyle değiştirince, izin takip sayfasındaki veriler mevcut haliyle de PUANTAJ sayfasına sorunsuz işleniyor.
.

If s1.Cells(6, o) >= CDate(s4.Cells(n, "B")) And s1.Cells(6, o) < CDate(s4.Cells(n, "C")) Then

 

[selcuk23]

ayrıca izin takipteki bilgileri başka bir dosyadan kopyala yapıştır yapıyorum. manuel tek tek girseydim tarihleri 15/05/2018 olarak yazar sorun kalmazdı.

 

[Ömer BARAN]

Bir cevap daha yazmıştım, sayfayı yenileyerek bir önceki cevabımı kontrol ediniz.

 

[selcuk23]

If s1.Cells(2, gün) <> "" Then

değişmesini istediğiniz ilgili satır bu mu acaba

 

[Ömer BARAN]

Kod'un son kısmında, 'İzin vs işleme diye eklenmiş olan not/açıklama satırının (bu satır yeşil renklidir) altında,
üçüncü For satırının altındaki ikinci If satırı.

 

[selcuk23]

Ömer bey çok teşekkürler ya çok güzel oldu . Aylardır uğraşıyorum yardım istiyorum bir çözüm bulunamamıştı. emeğinize sağlık.. Konu ile alakalı bir sorun daha var . yine izin takipteki bir isim ile personel listesindeki isim bire bir aynı yazılmazsa( büyük -küçük harf olarak) yine işlemiyor,, örneğin personel deki isim Serkan YILMAZ şeklinde yazılmış ama izin takipte hata ile (serkan YILMAZ ) yazılırsa izin işlemiyor.... bu günlük soru hakkınızı kullandınız derseniz saygı duyarım

 

[Ömer BARAN]

Estağfurullah, sorun değil.
Bakarım ve bu konu sayfasına olumlu olumsuz cevap yazarım.
Peki izin takip sayfasındaki isimler de mi kopyala yapıştır ile alınıyor acaba?
Doğru yöntem hücreye veri doğrulama uygulayarak yanlış veri girilmesini engellemektir.

Bu arada ben de size özelden bir soru gönderiyorum, ilgilenirseniz sevinirim.
.

 

[Ömer BARAN]

Biraz evvel düzelttiğimiz satırın üç-dört satır üstündeki ilgili kısmı aşağıdakiyle değiştirin.
Mavi olanlar mevcut haliyle kalanlar, kırmızılar eklenen iki satır, yeşiller değişecek olanlar.
Yani, aşağıdaki kod satırlarının tümünü seçip kopyalayın, mevcut kod'da mavi olanlar dahil seçip onların yerine yapıştırın.
.

            For n = 2 To sonizin
                pisim = WorksheetFunction.Proper(WorksheetFunction.Trim(s1.Cells(m, "B")))
                iisim = WorksheetFunction.Proper(WorksheetFunction.Trim(s4.Cells(n, "A")))
                If iisim Like pisim Then
                    For o = 5 To 35

 

[Ömer BARAN]

.
Son cevabımla ilgili geri bildirimde bulunmadınız.
İStediğiniz işlem, bundan önceki son cevabımdaki düzeltme ile gerçekleşilor mu?
.

 

[selcuk23]

Kusura bakmayın iş yoğunluğundan yeni deneme şansı buldum, evet bu düzeltme ile küçük - büyük harf sorunu ortadan kalktı. ancak şöyle bir sorun oluştu ad soyad arasında birden fazla boşluk koyduğumda hata verdi mesela ;Serkan_ _ YILMAZ arasında birden fazla boşluk koyduğumda izini işlemedi,, yinede bu haliyle çok güzel oldu tekrardan emeğinize sağlık, tşkler,

 

[Ömer BARAN]

Kod'u düğmeyi kullanarak değil de VBA ekranında iken F8 tuşuna basarak adım adım çalıştırıp,
Kod'daki;
-- PUANTAJ sayfasındaki satır numarasına ilişkin For m = ,,,,, Next döngüsünde m değişkeni, arasında bir'den fazla boşluk olan kişi satırının değeri,
-- ve izin sayfasındaki satır numarasına ilişkin For n = .... Next döngüsünde de n değişkeni aynı kişinin izin bilgisi satırının değeri
iken; F8 tuşuna basıp If iisim Like pisim Then satırına gelindiğinde, bu If satırındaki pisim ve iisim değişkenlerinin üzerine fareyle gelip az beklerseniz bu değişkenlerin aldığı değerler iki sayfadaki aynı kişinin isimleri olmalı ve birbirinin aynısını görüyor olmalısınız. Bu ikisi aynı mı değil mi acaba?
Bu mesajı belgenizi açmadan yazıyorum.
Umarım yanılmıyorum.

 

[Ömer BARAN]

Bir önceki mesajımın anlatması ve uygulaması biraz güç oldu.
En iyisi şöyle yapın, işlem kökten hallolsun.
Mevcut puantaj makrosunun son kısmındaki, 'İzin vs işleme diye eklenmiş olan not/açıklama satırının (bu satır yeşil renklidir) altında kalan kısmının tamamını silip (End Sub satırı hariç) bunun yerine aşağıdakini yapıştırın.

SONRADAN İLAVE NOT : Tüm işlemlerin uygulandığı çözüm belgesine 24 numaralı cevaptan erişebilirsiniz.
.