• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

H

hamza2011

Katılım
21 Eylül 2018
Mesajlar
87
Excel Vers. ve Dili
2010/Türkçe
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.
 

Ekli dosyalar

Merhaba,

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

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

C++: 
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 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?
 

Ekli dosyalar

Gelen uyarıya hayır derseniz biçimlendirmeniz çalışır.
 
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.
 
Makronun içinde zaten saydırma kodu var. İSİM saydırılıyor. İlgili alanda varsa uyarı veriyor. Bu yeterli değil mi?
 
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
 
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
 

Ekli dosyalar

Deneyiniz.

C++: 
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
 
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 :) )
 
Örnek verir misiniz?

Renklendirmeyi siz koşullu biçimlendirme ile yapabilirsiniz diye düşünüyorum.
 
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.
 
Sanırım bu durumu D ve E sütunları için istiyorsunuz.
 
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ı.
 
C ve D nereden çıktı? Örnek dosyalarınız sanırım farklı..
 
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ı
 
Deneyiniz.

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

C++: 
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
 
Korhan Hocam, çok mutluyum, çok teşekkür ederim. Elinize sağlık.
 
Korhan hocam merhaba, aşağıdaki alan silindikten sonra yerine ? işareti nasıl konulur

If Not Alan Is Nothing Then Alan.ClearContents
 
Doğru anladıysam aşağıdaki gibi olabilir.

C++: 
If Not Alan Is Nothing Then
   Alan.ClearContents
   Alan.Value="?"
End If
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst