AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI

[voleclub]

Tablo ile başlayan sayfalar öğretmenlerimizin aylık çalışma çizelgesidir.(tablo1 Dogan Öner hocamızın çalışma çizelgesi gibi)Her tablonun c5:k40 hücreleri arası öğrenci giriliyor.Tablo 1'in c6 hücresine yasin yıldız isimli öğrenci girilmişse yasin yıldız tabloyl başlayn başka bir sayfanın c6 hücresine yazılırsa mavi renk olsun.(Cünkü bir öğrenci aynı gün ve aynı saatte başka bir derste olmaycağı için yanlışlıkla yazılırsa bildirsin) .Teşekkürler.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[voleclub]

Kısacası aynı hücrelere aynı verilerin girilmesini istemiyorum.Bütün sayfalardaki c5 hücresine,aynı verinin girildiğinde beni uyarmasını istiyorum.(örneğin sayfa 1 in c5 hücresine kayseri varsa sayfa 2-3-4......in c5 hücrelerine kayseri girilirce renk değişerek beni uyarsın.

[Rami]

Merhaba:

Tablo 1'in c6 hücresine yasin yıldız isimli öğrenci girilmişse yasin yıldız tabloyl başlayn başka bir sayfanın c6 hücresine yazılırsa mavi renk olsun.

Soru başlığınıza ve bu ifadenize göre:
Bir gün içinde birbirini takip eden saatlerde dokuz saat ders görme ihtimali var.

Bir öğrenciye bir günde en fazla kaç saat ders veriliyor.?
Bir öğrenciye bir hafta da en fazla kaç saat ders veriliyor.?

Bunları sınırlayıp..! Uyarı verilecek şekilde bir makro yazılırsa; daha iyi olur.

[voleclub]

Haftada en fazla 2 saat isten aynı günde istersen farklı günde yazılabilir.Farklı öğretmenlere aynı gün aynı saat  yazılırlırsa bir çakışma olur. Yani bir öğrenci aynı gün ve aynı saatte iki farklı öğretmende olamayacagından beni uyarmasını istiyorum.

[Rami]

Haftada en fazla 2 saat isten aynı günde istersen farklı günde yazılabilir.Farklı öğretmenlere aynı gün aynı saat  yazılırlırsa bir çakışma olur. Yani bir öğrenci aynı gün ve aynı saatte iki farklı öğretmende olamayacagından beni uyarmasını istiyorum.

Ek dosyayı inceleyin.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[voleclub]

Rami Bey ilginiz için teşekkür ederim.Sizin yaptığınız istediğim gibi ama bütün sayfalar ve bütün hücreler (c5:K40 için istiyorum)için oluyor.
Aşagıdaki kod ise İlk beş harfi tablo olan c5:k40 arasındaki hücreler için aynı hücreye aynı veri girince uyarıyor ve siliyor. Biz bu kodu nasıl silmeden renk değiştirir şekline dönüştürebiliriz.
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim tpl As Integer, syf As String
If Intersect(Target, [C5:K40]) Is Nothing Then Exit Sub
Application.EnableEvents = False
syf = UCase(Replace(Replace(ActiveSheet.Name, "ı", "I"), "i", "İ"))
If Left(syf, 5) <> "TABLO" Then Exit Sub
For Each sh In Worksheets
    If Left(syf, 5) = "TABLO" Then
        tpl = tpl + WorksheetFunction.CountIf(sh.Range(Target.Address), Target.Value)
    End If
Next
If tpl > 1 Then
    MsgBox Target.Value & " Başka sayfada kayıtlı." & vbLf & "ZİÇEV", vbOKOnly + vbInformation, "ZİÇEV"
    Target.Value = ""
    Target.Select
End If
Application.EnableEvents = True
End Sub

[Rami]

Aşağıdaki gibi olabilir.

Kod: [Seç]

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim tpl As Integer, syf As String
If Intersect(Target, [C5:K40]) Is Nothing Then Exit Sub
Application.EnableEvents = False
syf = UCase(Replace(Replace(ActiveSheet.Name, "ı", "I"), "i", "İ"))
If Left(syf, 5) <> "TABLO" Then Exit Sub
For Each sh In Worksheets
    If Left(syf, 5) = "TABLO" Then
        tpl = tpl + WorksheetFunction.CountIf(sh.Range(Target.Address), Target.Value)
    End If
Next
If tpl > 1 Then
    MsgBox Target.Value & " Başka sayfada kayıtlı." & vbLf & "ZİÇEV", vbOKOnly + vbInformation, "ZİÇEV"
   
    Target.Cells.Font.ColorIndex = 33
    Target.Select
Else
   Target.Cells.Font.ColorIndex = xlAutomatic
End If
Application.EnableEvents = True
End Sub
Bu kod aynı hücre haricinde çalışmıyor. Yani aynı tarihte başka sütun da uyarı vermiyor.

[voleclub]

Rami Bey teşekkürler,  istediği gibi olmuş çakışınca renk değişiyor.Ancak o hücreyi silmeden başka bir hücreye çakışma olmayacağı için tekrar siyaha dönebilirmi yani çakıma olunca  mavi olmayınca siyah olsun...teşekkürler.

[Rami]

Yukarıdaki kod değişti deneyin.

[voleclub]

Rami Bey dediğiniz kodu yazdım. Ancak tablo yazan sayfalardan bir veri silince problem oluyor,excel kilitleniyor.

[Rami]

Rami Bey dediğiniz kodu yazdım. Ancak tablo yazan sayfalardan bir veri silince problem oluyor,excel kilitleniyor.

Hata mesajı veriyorsa; kodların baş tarafını aşağıdaki gibi değiştirip deneyin.

Kod: [Seç]


Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
On Error Resume Next
If Target.Cells = "" Then Exit Sub
'.....
'....


[voleclub]

Sayın Rami Bey,Tablo ile başlayan sayfaların C5:K40 arasından bir veri silince excelde uyarı mesajı geliyor. Exceli kapatmak zorunda kalıyorum .Dosyayı eke koydum size zahmet bakarmısınız.

[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[Rami]

Merhaba.
Tablo adlı sayfalardaki kodları aşağıdakiyle değiştirin.
(Tablo adlı sayfalar "TABLO1,TABLO2,.......,TABLO20" şekliyle 20 tane den eksik olmamalı.  Eğer dosyanızdaki sayfa adları farklı ise eski kodlarınızı kullanıp aşağıdaki işaretli bölümü değiştirin.)

Kod: [Seç]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim adr2 As String
If Intersect(Target, [C5:K10,C11:K16,C17:K22,C23:K28,C29:K34,C35:K40]) Is Nothing Then Exit Sub
On Error Resume Next
adr2 = Target.Address
If Target.Row <= 10 Then
    adr = Range("C5:K10").Address
    ElseIf Target.Row <= 16 Then
    adr = Range("C11:K16").Address
    ElseIf Target.Row <= 22 Then
    adr = Range("C17:K22").Address
      ElseIf Target.Row <= 28 Then
    adr = Range("C23:K28").Address
    ElseIf Target.Row <= 34 Then
    adr = Range("C29:K34").Address
    ElseIf Target.Row <= 40 Then
    adr = Range("C35:K40").Address
End If
For x = 1 To 20
mc = WorksheetFunction.CountIf(Sheets("TABLO" & x).Range(adr), Target.Value) + mc
next
If mc > 2 Then
'................................................................................................
    Target.Select
   If Target.Value <> "" Then
    MsgBox Target.Value & " BU HAFTA 2 DERS SAATLİK LİMİTİNİ DOLDURMUŞTUR" & vbLf & "LÜTFEN BAŞKA HAFTAYA YAZINIZ", vbOKOnly + vbInformation, "Dikkat"
    Target.Value = ""
  End If
End If
'...
End Sub

[voleclub]

Rami Bey Aslında benim kitabımda 20 tane tablo var ben  sizin daha iyi anlamanız için kısattmıştım.Şimdi ne yapmam lazım.

[Rami]

Rami Bey Aslında benim kitabımda 20 tane tablo var ben  sizin daha iyi anlamanız için kısattmıştım.Şimdi ne yapmam lazım.

Tablo isimli sayfalar "TABLO1,TABLO2,TABLO3,...." Şeklinde "TABLO20" ye kadar eksiksiz devam ediyorsa yukarıdaki
kodları kopyalayıp bütün "TABLO" adlı sayfalardaki " Private Sub Worksheet_Change(ByVal Target As Range)" ve altındaki kodları değiştirin.