Soru İç içe for döngüsü hakkında yardım

[hamza2011]

Merhaba,
Örnek dosyada açıklamalı halde belirttim. İç içe for döngüsünü çalıştıramadım. Lütfen konu hakkında yardım eder misiniz.

 

[Korhan Ayhan]

Merhaba,

Ekteki gibi bir çözüm işinize yarar mı?

Sayfadaki tüm kodu silip aşağıdaki kodu uygulayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D7:E1000")) Is Nothing Then Exit Sub
    If WorksheetFunction.CountIf(Range("H36:H50"), Target) > 0 Then
        If MsgBox("Çizelgede hata var. Devamsız personel çalıştırılamaz!" & Chr(10) & _
                  "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
            Target = Empty
            Target.Select
        End If
    End If
    If WorksheetFunction.CountIf(Range("I13:I32"), Target) > 0 Then
        If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
                  "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
            Target = Empty
            Target.Select
        End If
    End If
End Sub

 

[hamza2011]

Korhan Bey, çok teşekkür ederim Allah razı olsun. ilave olarak "I13:I32" hücrelerine sütununa koşullu biçimlendirme yapmıştım. Sadece "İSİM1" ve "İSİM2" de benzer olduğunda zemin kırmızı oluyor. Yazdığınız makroyu bu koşullu biçimlendirme doğruysa (yani kırmızı) çalıştırılabilir mi?

 

[Korhan Ayhan]

Gelen uyarıya hayır derseniz biçimlendirmeniz çalışır.

 

[hamza2011]

Korhan Bey, sanırım ifade edemedim. I13 ve I19' daki hücrelerde iki koşullu biçimlendirme var. Biri yeşil renkli diğeri kırmızı. Çalışamayacak olanlar kırmızılardır. Yani I13 ve I19' daki kişi yeşilse msgbox vermeyecek. Kırmızı ise yazdığınız gibi msgbox vermesi, makro çalışması gerekiyor. Yani kırmızı renk koşuluna göre.

 

[Korhan Ayhan]

Makronun içinde zaten saydırma kodu var. İSİM saydırılıyor. İlgili alanda varsa uyarı veriyor. Bu yeterli değil mi?

 

[hamza2011]

Buradaki durum göreceli Korhan Bey,
Kişi isimlerdeki sütunlarda duruma göre olabilir çalışabilir bunları yeşile boyuyorum. Olamaz çalışamaz dediklerimi de kırmızıya boyuyorum. Koşullu biçimlendirme de hücre rengi kırmızı ise makro msgbox çalışsın istemiştim.

Bu hali ile de kalabilir Korhan Bey zahmet verdim hayırlı geceler,

tekrar sağlıklı günler dilerim

 

[hamza2011]

Korhan Hocam tekrar merhaba,
Sizden ricam Ek'teki sorunum için aşağıdaki kodları yazmıştınız. Aynı işlemi yani "İSİM1", "İSİM2" ve "Hafta Tatili" olan kişileri devamsızlar tablosuna yazdığımda uyarı vermesini sağlayabilir miyiz.


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D7:E1000")) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf(Range("H36:H50"), Target) > 0 Then
If MsgBox("Çizelgede hata var. Devamsız personel çalıştırılamaz!" & Chr(10) & _
"Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
Target = Empty
Target.Select
End If
End If
If WorksheetFunction.CountIf(Range("I13:I32"), Target) > 0 Then
If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
"Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
Target = Empty
Target.Select
End If
End If
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D7:E1000")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Range("H36:H50"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Devamsız personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Target = Empty
                Target.Select
            End If
        End If
        If WorksheetFunction.CountIf(Range("I13:I32"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Target = Empty
                Target.Select
            End If
        End If
    ElseIf Not Intersect(Target, Range("H6:H50")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Range("I13:I32"), Target) > 0 Or WorksheetFunction.CountIf(Range("D7:E1000"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Target = Empty
                Target.Select
            End If
        End If
    End If
End Sub

 

[hamza2011]

Hocam çok teşekkür ederim. Hakkınızı helal ediniz.

Son olarak bir ricam daha var. İkinci isim yazıldığında "evet", "hayır" seçenekli olarak geliyor; evet denildiğinde ilk ismin silinmesi, hayır denildiğinde ikinci ismin silinmesi. (ve ilave olarak benzer olduklarından zemin rengi kırmızı olabilir mi )

 

[Korhan Ayhan]

Örnek verir misiniz?

Renklendirmeyi siz koşullu biçimlendirme ile yapabilirsiniz diye düşünüyorum.

 

[hamza2011]

Hocam dediğiniz gibi renklendirmeyi koşullu biçimledirmeden yapabilirim. Ben makro hali ile yapsam mı acaba diye düşünmüştüm. O önemli değil.

Siz "İkinci isim yazıldığında "evet", "hayır" seçenekli olarak geliyor; evet denildiğinde ilk ismin silinmesi, hayır denildiğinde ikinci ismin silinmesi." bunu yapabilir misiniz.

 

[Korhan Ayhan]

Sanırım bu durumu D ve E sütunları için istiyorsunuz.

 

[hamza2011]

C ve D sütunundaki personel devamsızlara yazılırsa ve evet denildiğinde C ve D' den silinmesi , hayır denilirse yerinde yani C ve D sütununda kalması,
Devamsızlardaki personel C ve D' ye yazılırsa ve evet denildiğinde devamsızlardan silinmesi, hayır denilirse yerinde yani devamsızlarda kalması,
Hafta tatilindeki personel devamsızlara yazılırsa ve evet denildiğinde hafta tatilinden silinmesi, hayır denilirse yerinde yani hafta tatilinde kalması.

 

[Korhan Ayhan]

C ve D nereden çıktı? Örnek dosyalarınız sanırım farklı..

 

[hamza2011]

Pardon hocam, evet D ve E için istiyorum.

D ve E sütunundaki personel devamsızlara yazılırsa ve evet denildiğinde D ve E' den silinmesi , hayır denilirse yerinde yani D ve E sütununda kalması,
Devamsızlardaki personel D ve E' ye yazılırsa ve evet denildiğinde devamsızlardan silinmesi, hayır denilirse yerinde yani devamsızlarda kalması,
Hafta tatilindeki personel devamsızlara yazılırsa ve evet denildiğinde hafta tatilinden silinmesi, hayır denilirse yerinde yani hafta tatilinde kalması

 

[Korhan Ayhan]

Deneyiniz.

Umarım doğru anlamışımdır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range, Adres As String, Alan As Range
    If Not Intersect(Target, Range("H6:H50")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Range("D7:E1000"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Set Bul = Range("D7:E1000").Find(Target, , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Alan Is Nothing Then
                            Set Alan = Bul
                        Else
                            Set Alan = Union(Alan, Bul)
                        End If
                        Set Bul = Range("D7:E1000").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                End If
                If Not Alan Is Nothing Then Alan.ClearContents
            End If
        End If
    
        If WorksheetFunction.CountIf(Range("I13:I32"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Set Bul = Range("I13:I32").Find(Target, , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Alan Is Nothing Then
                            Set Alan = Bul
                        Else
                            Set Alan = Union(Alan, Bul)
                        End If
                        Set Bul = Range("I13:I32").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                End If
                If Not Alan Is Nothing Then Alan.ClearContents
            End If
        End If
    ElseIf Not Intersect(Target, Range("D7:E1000")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Range("H36:H50"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Devamsız personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Set Bul = Range("H36:H50").Find(Target, , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Alan Is Nothing Then
                            Set Alan = Bul
                        Else
                            Set Alan = Union(Alan, Bul)
                        End If
                        Set Bul = Range("H36:H50").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                End If
                If Not Alan Is Nothing Then Alan.ClearContents
            End If
        End If
    ElseIf Not Intersect(Target, Range("I13:I32")) Is Nothing Then
        If WorksheetFunction.CountIf(Range("I13:I32"), Target) > 0 Then
            If MsgBox("Çizelgede hata var. Hafta tatilinde olan personel çalıştırılamaz!" & Chr(10) & _
                      "Girilen isim silinsin mi?", vbCritical + vbYesNo, "DİKKAT !") = vbYes Then
                Set Bul = Range("H36:H50").Find(Target, , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        If Alan Is Nothing Then
                            Set Alan = Bul
                        Else
                            Set Alan = Union(Alan, Bul)
                        End If
                        Set Bul = Range("H36:H50").FindNext(Bul)
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                End If
                If Not Alan Is Nothing Then Alan.ClearContents
            End If
        End If
    End If
End Sub

 

[hamza2011]

Korhan Hocam, çok mutluyum, çok teşekkür ederim. Elinize sağlık.

 

[hamza2011]

Korhan hocam merhaba, aşağıdaki alan silindikten sonra yerine ? işareti nasıl konulur

If Not Alan Is Nothing Then Alan.ClearContents

 

[Korhan Ayhan]

Doğru anladıysam aşağıdaki gibi olabilir.

If Not Alan Is Nothing Then
   Alan.ClearContents
   Alan.Value="?"
End If