Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: voleclub - 14 Şubat 2011, 13:10:44

Başlık: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 14 Şubat 2011, 13:10:44

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.]

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 14 Şubat 2011, 20:42:19

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 15 Şubat 2011, 17:19:33

Merhaba:

Alıntı yapılan: voleclub - 14 Şubat 2011, 13:10:44

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 15 Şubat 2011, 20:32:57

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 16 Şubat 2011, 01:44:18

Alıntı yapılan: voleclub - 15 Şubat 2011, 20:32:57

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.]

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 16 Şubat 2011, 08:08:36

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 16 Şubat 2011, 08:42:14

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 16 Şubat 2011, 15:45:37

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 16 Şubat 2011, 16:26:55

Yukarıdaki kod değişti deneyin.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 16 Şubat 2011, 17:48:06

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 17 Şubat 2011, 09:49:56

Alıntı yapılan: voleclub - 16 Şubat 2011, 17:48:06

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
'.....
'....


Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 17 Şubat 2011, 17:54:48

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.]

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 17 Şubat 2011, 20:39:44

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 17 Şubat 2011, 20:45:58

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 17 Şubat 2011, 20:58:33

Alıntı yapılan: voleclub - 17 Şubat 2011, 20:45:58

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.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 17 Şubat 2011, 21:08:18

Rami bey dediğiniz gibi değiştirdim ama yine  hata veriyor.

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 17 Şubat 2011, 21:22:50

Aşağıdaki örnekteki gibi olmalı:

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 17 Şubat 2011, 21:35:43

Rami Bey çok teşekkür ederim.Küçük bir şey daha isteyeceğim. c5:k10 arasına aynı 3 veri girince birini siliyorya biz onu silmesekte renk değiştirse olurmu?

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 17 Şubat 2011, 22:28:47

O zaman:
"ThisWorkbook" altındaki kodları:

Kod: [Seç]

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim tpl As Integer, syf As String
On Error Resume Next
If Target.Value = "" Then Exit Sub
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
If Target.Cells.Font.ColorIndex <> 3 Then Target.Cells.Font.ColorIndex = xIAutomatic
End If
Application.EnableEvents = True
End Sub

"Tablo" sayfalarıdaki kodları da aşağıdaki gibi değiştirmek gerekli:

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 = 2 To 5
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.Cells.Font.ColorIndex = 3
  End If
End If
If mc <= 2 Then Target.Cells.Font.ColorIndex = xlAutomatic
End Sub 
Ancak veri değiştirilip hücreden çıkıncaya kadar; yazı rengi kırmızı olacaktır.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 17 Şubat 2011, 23:26:17

RAmi Bey ben mi yapamadım dediğinizi yazdım ama hata veriyor.

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 18 Şubat 2011, 00:14:16

Tabloya yazılan kodlar çok güzel çalışıyor ancak "ThisWorkbook" altındaki kodlar çalışmıyor.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 18 Şubat 2011, 08:23:19

Siz yukarıdaki "Thisworkbook" altıntaki kodları
 

Kod: [Seç]

'.....
'......
If Target.Cells.Font.ColorIndex <> 3 Then
Target.Cells.Font.ColorIndex = xIAutomatic
End If
End If '...eksik......................
Application.EnableEvents = True
End Sub
şeklinde değiştirerek yazmışsınız "End ıf" noksan.

Ya önceki ki mesajımdaki kodu aynen yazın veya böyle değiştirin.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 18 Şubat 2011, 20:57:22

Rami Bey elinize sağlık ,Tablo 1 de 3 tane AAA var .İkincisinden sonraki yani ücüncüsü kırmızı oluyor.  3 tane aynı veri varsa üçüde kırmızılaşabilirmi.
2. si ise 3 veriden birini silince kırmızı renkler geri siyah olabilir mi?

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

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: Rami - 18 Şubat 2011, 21:22:00

Alıntı yapılan: Rami - 17 Şubat 2011, 22:28:47

Ancak veri değiştirilip hücreden çıkıncaya kadar; yazı rengi kırmızı olacaktır.

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 18 Şubat 2011, 21:38:31

Bu kodu iki tane aynı veri varken üçüncü aynı veriyide girince üçüde kırmızı olsun ve işlemi düzeltip 3 taneden her hangi birini sildikten sonra geri kalan 2'si siyah olsuna dönüştürebilirmiyiz.Teşekkürler.
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.Cells.Font.ColorIndex = 3
End If
End If
If mc <= 2 Then Target.Cells.Font.ColorIndex = xlAutomatic
End Sub

Başlık: Ynt: AYNI HÜCREYE AYNI VERİ GİRİLİNCE UYARMASI
Gönderen: voleclub - 21 Şubat 2011, 23:23:36

Rami Bey,
"ThisWorkbook" altındaki kodları bir butona atasak olurmu?
Yani tüm tabloyu doldurduktan sonra o butona basınca tüm aynı saate gelen (çakışan) dersleri yeşile çevirse olurmu?