Çözüldü 2 veya üzeri sarı renk dolgu ile yazılı olan "HT" ibaresi var ise uyarı vermesi hakkında.

[Garuramon]

Merhaba Arkadaşlar,

Konu başlığına tam olarak ne yazacağımı bulamadığım için bir uzun yazdım.

Hazırlamış olduğum Excel dosyasında F:28 ile AJ28 hücreleri arasında sarı renk dolgu ile 2 defa yazılı "HT" ibaresi var normalde her kişide 1 defa sarı renk dolgu ile "HT" yazmalıyım. 2 ve üzeri sarı renk dolgu ile "HT" ibaresi var ise D:28 hücresini kırmızı renk dolgu ile göstermesine 1 defa yazılı ise yeşil renk dolgu ile gösterilmesine ihtiyacım var. Bundaki amaç şu her personele ayda bir defa fazladan hafta tatili yazabiliyorum, bunu herhangi personele 2 veya üzeri yazarsan uyarı olsun istiyorum. Farklı bir çözüm önerisi de olabilir. Benim aklıma gelen çözüm bu.Bu konuda yardımcı olur musunuz.

 

[halit3]

Bu makroyu bir dene

Sub Makro1()

For i = 14 To 29
say = 0

Cells(i, 4).Interior.Color = 5296274
For j = 6 To 36

If Cells(i, j).Interior.Color = 65535 Then
say = say + 1
End If

Next j

If say >= 2 Then
Cells(i, 4).Interior.Color = 255
End If

Next i

End Sub

 

[Garuramon]

Sayın @halit3

Çok güzel çalışıyor. Ancak sayfaya veri girdiğim sırada uyarı alamıyorum. Macro çalıştır demem gerekiyor bunun bir çözümü var mıdır.

 

[muygun]

Merhaba;
Halit Bey sorunu çözmüş ama yaptığım ek Alternatif olsun.
İnceleyin.
İyi çalışmalar.

 

[halit3]

Merhaba siz renklendirme yapıyorsunuz onun için bu şekilde olmuyor hücrelere değer yazdığınızda kodu çalıştırmak gerekiyor.

bu kodu sayfanın kod

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [F14:AJ29]) Is Nothing Then Exit Sub
Target.Interior.ColorIndex = xlNone

If Target.Value = "HT" Then Target.Interior.Color = 65535

For i = 14 To 29
say = 0

Cells(i, 4).Interior.Color = 5296274
For j = 6 To 36

If Cells(i, j).Interior.Color = 65535 Then
say = say + 1
End If

Next j

If say >= 2 Then
Cells(i, 4).Interior.Color = 255
End If

Next i

End Sub

bölümüne kopyala ve hücrelere değer yaz irdele

 

[Garuramon]

Sayın @muygun ve @halit3 ,

Kısa sürede inceleyip geri dönüş yapacağım.

 

[halit3]

Kod birazcık uzun oldu bunu dene

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [F14:AJ29]) Is Nothing Then Exit Sub
Target.Interior.ColorIndex = xlNone
i = Target.Row


If Target.Value = "HT" Then
Target.Interior.Color = 65535
End If

Cells(i, 4).Interior.Color = 5296274
say = 0

For j = 6 To 36
If Cells(i, j).Value = "HT" Then

If Cells(i, j).Interior.Color = 65535 Then
say = say + 1
End If
End If
Next j

If say >= 2 Then
Cells(i, 4).Interior.Color = 255
End If

End Sub

 

[Garuramon]

Sayın @muygun

Çözüm öneriniz olan kod EK' li dosyada olması gerektiği gibi çalışıyor ancak, kodu başka bir dosyanın kod sayfasına eklediğim zaman çalışmıyor. Bende bir sorun olduğunu düşünüyorum. Tekrar gözden geçireceğim.

 

[Garuramon]

Sayın @muygun

Sizin eklemiş olduğunuz kodu da başka dosyanın kod sayfasına ekliyorum kayıt edip çıkıyorum ancak çalışmıyor. Bir yerde hata yapıyorum sanırım.

 

[halit3]

7 nolu mesajdaki kodu yeniden düzenledim.

 

[Garuramon]

Sayın @halit3

7 nolu mesajdaki kod buton kullanıldığı zaman çok güzel çalışıyor. Çok teşekkür ederim

Sayın @muygun

4 nolu mesajdaki çözüm öneriniz benim ihtiyacım olan ama kullandığım dosyada kodu çalıştıramadım maalesef. Size de çok teşekkür ederim.

 

[halit3]

7 nolu mesajdaki dosyada hücrelere veri girişi yapın ve sonuçları gözlemleyiniz.
kod hücreye değer girdiğinizde de çalışıyor.

 

[Garuramon]

Sayın @halit3

7 nolu mesajdaki dosyayı incelediğimde HT yazılı olan hücreye çift tıkladığımda hücre renginin sarı renk dolgu olduğunu, aynı satırda bunu ikinciye tekrarlamam durumunda D sütunundaki dolgu renginin kırmızı renk olduğunu gördüm.

Çözüm olarak kullanılabilir ama benim ihtiyacım olan çözüm bu değil maalesef. Belkide ben doğru ifade etmemiş olabilirim. Özür dilerim.

Sayın muygun' un 4 nolu mesajdaki çözüm bana en yakın olanı ama onuda gerçek dosyamın kod bölümüne ekledim ancak çalıştıramadım.

 

[halit3]

Hücrelere veri giriniz mesela 1 yazın sonra entere basıp çıkın hücreden daha sonra aynı hücreye HT yazın ve entere basın çıkın sonuçları gözlemleyiniz.

Hücreye HT yazdığınızda ilgili hücre sarı renk oluyor sildiğinizde renk oluşmuyor.

 

[Garuramon]

Sayın @halit3

Kullandığım dosyada bir personele ay içerisinde yaklaşık 10-12 defa HT (Hafta Tatili) yazıyorum. Birde bu izinler dışında herhangi bir gün değerlendirmem sonucunda fazladan 1 gün HT yazabiliyorum. Gecen ay bir personele farkında olmadan 1 gün yerine 2 gün fazladan HT (Sarı Dolgu) yazdığımın farkına vardım. Ay içindeki izinlerinin dışında benim vermiş olduğum izinleri sarı dolgu ile işaretliyorum. Bu nedenden dolayı formül,kod,koşullu biçimlendirme vb.... işlemin ben 2 defa ve üzeri sarı renk dolgu ile belirtir ve HT yazarsam beni uyarsın. Sizin eklediğiniz dosyada HT yazdığım yeri sarı dolgu yapıyor. İhtiyacım bu değil.

 

[halit3]

Evet anladım mademki ilk makro işinizi gördü o zaman o makro ile ilgili bu eklediğim makroyu sayfanın kod bölümüne yapıştır
not : kodun çalışması için önce dolgu rengini silin veya dolgu rengini sarı yapın sonrada hücreye değer girin veya değiştirin yada değeri silin

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [F14:AJ29]) Is Nothing Then Exit Sub

For i = 14 To 29
say = 0

Cells(i, 4).Interior.Color = 5296274
For j = 6 To 36

If Cells(i, j).Interior.Color = 65535 Then
say = say + 1
End If

Next j

If say >= 2 Then
Cells(i, 4).Interior.Color = 255
End If

Next i


End Sub

 

[muygun]

Merhaba;
renkleri CH1 ve CI1 hücrelerinden almakta (gönderdiğim örnekte bu hücrelere bakın) dolayısıyla buna göre mukayese etmekte...
taşıdığınız dosyada ilgili adreslere bu renkleri uygularsanız ihtimalle sorun ortadan kalkar.
İyi çalışmalar.

 

[Garuramon]

Sayın @muygun,

Sorunu sayenizde çözdüm, çok teşekkür ederim.

Sayın @halit3 ,

Maalesef çözüm önerinizi çalıştıramadım. Belkide ben hatalıyım, neye ihtiyacım olduğunu tam olarak anlatamadım. Ancak sonuç ne olursa olsun, zaman ayırdığınız için ve uğraştığınız için çok teşekkür ederim. Yarın sabah sağlam kafa ile dosyaya tekrar bakacağım ve tekrar deneyeceğim.