Personele aynı günlerde iş vermeme

[S.Yiğit]

Merhaba,

Ekteki çalışmamda personele bir tarihte bir iş veriliyor (D sutunu)
ve yan sutununda bu işi kaç günde bitireceği yazıyor (E sutunu)

yapmak istediğim bu liste uzayıp gidiyor. aynı personele aynı tarihlerde iş vermemeli. eki incelerseniz demek istediğimi anlayabilirsiniz..

 

[S.Yiğit]

Merhabalar,

Yukarıdaki konu hakkında bana yardımcı olacak kimse yokmu?

 

[S.Yiğit]

Merhaba,

Dosyayı tekrar ekledim (2003 formatında)

yardım edebilir misiniz?

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı inclermisiniz. Uyarı işlemi makro ile yapılmıştır.

 

[S.Yiğit]

hocam çok sağulun. yanlız bir yerde bir sorun var.. gönderdiğiniz örnekte D6'ya 4/2/2011 yazıp E6'ya 2 yazınca renk gidiyor. oysaki 5/2/2011 de ayhana 3 gün iş verilmiş. Ayhan için 4/2/2011 tarihiyle başlayan iş verilmemesi lazım.. makro olarak bişey yapabilirseniz çok sevinirim.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyada gerekli düzenleme yapılmıştır. İncelermisiniz.

 

[S.Yiğit]

Hocam çok sağolun.. eğer yapabilirseniz küçük bir düzeltme.. işlemimi iptal etmesin çünkü tarih kısmına gelene kadar bir çok bilgi veriyoruz, iptal ettiğinde hepsi gidiyor. sadece tarih yazdığımız hücreyi iptal etsin ki yenisini yazalım.. Emeğinize sağlık, çok teşekkürler..

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki dosyada gerekli düzenleme yapılmıştır. İncelermisiniz.

 

[S.Yiğit]

Hocam çok teşekkür ederim.. Herşey gönlünüzce olsun..

 

[S.Yiğit]

Korhan hocam merhaba,

Edit
Kodda kırmızıya boyadığım yerde hata veriyor. Anladığım kadarıyla benim uyarladığım kodda tarihin olduğu K sutununda metin olduğunda bu hata oluyor. Bazen personele plan tarihi belli olmadığı zaman not düşüyoruz (K sutununda Sizin kodda D sutunu) daha sonradan tarih girebiliyoruz.. ama işin süresi baştan belli olabiliyor.. Bu doğrultuda yardımcı olabilir misiniz? Teşekkürler..

Bir sıkıntı daha oluştu oda şöyle, Sıkıntımız aynı tedarikçiye aynı tarihlerde bir kaç iş verebiliyoruz.. bunun için boyama yapılaan sayfada birinci göre ikinci görev vb.. diye sutun açtım.. ama formatta sayfada değişiklik yapabiliriz. herhangi bir kısıtlamamız yok,

Sıralamamız Montaj tipi ne? Süpervisor ise aynı tarihlerde iş vermeyecek
Montaj tipi tedarikçi ise aynı günlerde iş verebilecek her ikisinde de boyadığı hücrelere proje noları gelecek.. PLAN sayfası hariç diğer sayfalarda değişiklik yapabiliriz...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range, ADRES As String, TARİH As Date, KONTROL As Boolean
    
    If Intersect(Target, Range("G3:L65536")) Is Nothing Then Exit Sub
    
    If Cells(Target.Row, "G") <> "" And Cells(Target.Row, "K") <> "" And Cells(Target.Row, "L") <> "" Then
        Set BUL = Range("G2:G" & Target.Row - 1).Find(Cells(Target.Row, "G"), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            [COLOR="Red"][B]For TARİH = Cells(Target.Row, "K") To Cells(Target.Row, "M")[/B][/COLOR]                If TARİH >= Cells(BUL.Row, "K") And TARİH <= Cells(BUL.Row, "M") Then
                    KONTROL = True
                    Exit For
                End If
            Next
            
            If KONTROL = True Then
                MsgBox Cells(Target.Row, "G") & " isimli mühendis için daha önce " & TARİH & " tarihinde iş planlaması yapılmıştır !" & Chr(10) & _
                "Aynı kişiye benzer tarih aralığında yeni iş planlaması yapamazsınız !" & Chr(10) & "İşleminiz iptal edilmiştir.", vbCritical
                Range("K" & Target.Row & ":L" & Target.Row).ClearContents
                Exit Do
            End If
        Set BUL = Range("G2:G" & Target.Row - 1).FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    End If
End Sub

Boyamayla ilgili Halit hocamın kodu aşağıdadır..

Sub aktar()
Worksheets("TARİH").Rows("6:1000").FormatConditions.Delete
Worksheets("TARİH").Rows("6:1000").ClearContents
sut = Worksheets("TARİH").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
sat = 6
For r = 2 To Worksheets("PLAN").Cells(Rows.Count, "g").End(3).Row
aranan1 = Sheets("PLAN").Cells(r, "g").Value
deg = 0
If Sheets("PLAN").Cells(r, "g").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("PLAN").Range("g2:g" & r), aranan1) = 1 Then
For i = r To Worksheets("PLAN").Cells(Rows.Count, "g").End(3).Row
If Sheets("PLAN").Cells(i, "g").Value <> "?" Then
If IsDate(Sheets("PLAN").Cells(i, "k").Value) = True Then
If IsNumeric(Sheets("PLAN").Cells(i, "L").Value) = True Then
aranan2 = Sheets("PLAN").Cells(i, "k").Value
aranan3 = Sheets("PLAN").Cells(i, "l").Value - 1
If aranan1 = Sheets("PLAN").Cells(i, "g").Value Then
For n = 2 To sut
If aranan2 = Sheets("TARİH").Cells(4, n).Value Then
deg = 1
Sheets("TARİH").Cells(sat, 1).Value = Sheets("PLAN").Cells(i, "g").Value
For j = n To aranan3 + n
Sheets("TARİH").Cells(sat, j).FormatConditions.Delete
Sheets("TARİH").Cells(sat, j).FormatConditions.Add Type:=xlExpression, Formula1:="=r" & sat & "c" & j & ">0"
Sheets("TARİH").Cells(sat, j).FormatConditions(1).Interior.ColorIndex = 3
Sheets("TARİH").Cells(sat, j).Value = Sheets("PLAN").Cells(i, 1).Value
Next j
Exit For
End If
Next n
End If
End If
End If
End If
Next i
End If
End If
If deg = 1 Then
sat = sat + 1
End If
Next r
MsgBox "işlem tamam"
End Sub

 

[S.Yiğit]

Merhabalar,

İki konum benden kaynaklanan sebeplerden birbirine karıştı. Yeni bir dosya hazırlayıp yeni bir konu açarak tek konu üzerinden gitmeye çalışacağım.. Yardımcı olan herkese teşekkürler..