• DİKKAT

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

Makro düzenlemesi (Mükerrer)

Katılım
13 Mayıs 2005
Mesajlar
761
Excel Vers. ve Dili
2010 Türkçe
Aşağıdaki makroda D ve G sütunlarında mükerrer kontrolü yapıyorum. Mükerrer kontrolüne ilave olarak D aynı G den büyük eşit H den küçük eşit şeklinde düzeltebilirmiyiz.
D hücresindeki isim G ve H tarihleri arasında tekrar bir tarih aralığı girilmesini engellemem lazım. Yardımınıza ihtiyacım var.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

   If Selection.Count > 1 Then Exit Sub
   If Intersect(Target, Range("D:G,M:M")) Is Nothing Then Exit Sub
   satir = Target.Row
   sutun = Target.Column
 
   sonsatira = Cells(Rows.Count, "D").End(3).Row
   sonsatirb = Cells(Rows.Count, "G").End(3).Row
    
    If Target.Column = 4 Then
        If Target.Row = sonsatira Then
            Worksheets("Rapor-Kişi").Range("D1") = Target
        End If
    End If
        
        
   If sonsatira > sonsatirb Then SonSatir = sonsatira Else SonSatir = sonsatirb
  
    If Target.Column = 13 Then
    If Sheets("Rapor-Kişi").[J5] < "0" Then
    MsgBox "Dikkat ! Yıllık İzin Günü " & Sheets("Rapor-Kişi").[J5] & "'e düştü. Lütfen kontrol ediniz ..!" & Chr(10), vbCritical
    Application.EnableEvents = False
    Cells(satir, "M").Value = ""
    Cells(satir, "H").Value = ""
    Cells(satir, "G").Value = ""
    Cells(satir, "D").Value = ""
    Cells(satir, "D").Select
    Application.EnableEvents = True
    Sheets("Kullanılan İzinler").Select
    Exit Sub
    End If
    Sheets("Kullanılan İzinler").Select
    Exit Sub
    End If
  
   Say = 0
   For i = 1 To SonSatir
     veria = Cells(i, "D").Value
     verib = Cells(i, "G").Value
     If veria = Cells(satir, "D").Value And verib = Cells(satir, "G").Value Then Say = Say + 1
   Next i
   If Say > 1 Then
    MsgBox (veria & " ve " & verib & " Mükerrer girildi.")
    
    Application.EnableEvents = False
     Cells(satir, "D").Value = ""
     Cells(satir, "G").Value = ""
     Cells(satir, "D").Select
    Application.EnableEvents = True

   End If
End Sub
 
Geri
Üst