Sonradan gelen tarih üsttekini takip etmiyorsa uyarı verme

[caca85]

Arkadaşlar merhaba ;
Ekteki dosyada hücrelere veya birleşmiş hücrelere yazan tarihler vardır.
Benim istediğim kullanıcı eğer bu tarihlerde giriş hatası yaptıysa (ay, yıl veya gün hatası veya boş bırakma)(ekteki dosyada kırmızı fontlu olan hücreler gibi) ekranda uyarı verip , hangi satırda hatalı giriş yaptığını söyleyen veya hatalı verinin olduğu sütunu ekrana getirerek (mesela 300.satırda hata var, ekranı kaydırıp 300.sütunu aktif edecek gibi) asıl makroyu sonlandıracak bir kod lazım.

Aslında benim asıl dökümanımdaki bütün tarihler; iş gereği ardışık girilmek zorunda ve boş hücre olma ihtimali yok. Sadece hücreler tek veya birkaç hücre birleşik olabiliyor.Ancak kullanıcı bu girişlerde hata yaparsa asıl makronun tarihlere göre yaptığı bütün hesapları etkiliyor. A sütünundaki hücreleri tarayıp, üstteki tarihle ardışık olmayan bir tarih girdisi için uyarı veren veya boş bir hücre veya alanla karşılaştığında uyarı veren bir kod yeterli.

Yardımlarınız için şimdiden teşekkür ederim.

 

[systran]

tarih bilgisi sırayla gidiyorsa koda gerek yok ki! bir sonraki satırda bir önceki tarihe 1 ilave etseniz?

 

[caca85]

tarih bilgisi sırayla gidiyorsa koda gerek yok ki! bir sonraki satırda bir önceki tarihe 1 ilave etseniz?

Sayın üstadım tabiki ben tarihleri girerken o şekilde giriyorum. Ancak bazen oluyor ki iş yoğunluğundan veya dalgınlığımdan yanlış giriş yapıyorum.Veya aynı sebeplerden programa giriş yapan başka bir arkadaşım tarihi yanlış giriyor veya girmiyor. Belki yıl ,belki ay, belki gün yanlış yazılabiliyor veya boş bırakılabiliyor.Belki günde 40-50 farklı firmanın ayrı ayrı girişleri yapılıyor. Benim bu kodu istememdeki amaç benim veya kullanıcının yanlışlıkla girdiği hatalı (ardışık olmadığı veya boş olduğu için bize göre hatalı tabi) tarih girişlerini algılayıp hesap yapmadan önce kullanıcıyı uyarması ve yönlendirmesi. Ve yanlış bir sonuç ortaya çıkarmaması.

 

[caca85]

çözüm

arkadaşlar kendim yaptım. Olur da bir gün böyle bir koda ihtiyacınız olursa kullanın. Ancak öncekine göre değil, bu mesajdaki ekli dosyaya göre hazırlanmıştır.

Sub tarihhata()

If Sheets.Count = 2 Then Sheets(2).Delete

Application.ScreenUpdating = False
Application.Wait (Now + TimeValue("0:00:01"))
For i60 = 1 To Range("A65536").End(3).Row
Cells(i60, 1).Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
Next i60

Sheets.Add After:=ActiveSheet: ActiveSheet.Name = "TARİH BOŞLUK KONTROL"
Worksheets(1).Select

lastrow30 = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A1:A" & lastrow30).Select
    
    Selection.Copy
    Worksheets("TARİH BOŞLUK KONTROL").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
For i62 = 1 To Range("A65536").End(3).Row
Cells(i62, 1).Select
Selection.UnMerge
Next i62

For i61 = 1 To Range("A65536").End(3).Row
Cells(i61, 1).Select
If Selection.Borders(xlEdgeTop).LineStyle = xlContinuous And Cells(i61, 1).Value = "" Then
Application.ScreenUpdating = True
Sheets(1).Select
Rows(i61).Select
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
MsgBox i61 & ".satırda tarih girişi olamdığı tespit edildi.Bilgilerinizi kontrol edip makronuzu yeniden çalıştırınız."
durum = 1
GoTo 2000
Else
End If
Next i61

'---------------------------------------------------------------------------------------------------

For i63 = 1 To Range("A65536").End(3).Row
        Worksheets(2).Cells(i63, 1).Value = Worksheets(1).Cells(i63, 1).Value
Next i63

Worksheets(2).Select
For i64 = 1 To Range("A65536").End(3).Row
If Cells(i64, 1) <> "" Then Cells(i64, 2).Value = i64
Next i64

Worksheets(2).Select
For i65 = 1 To Range("A65536").End(3).Row
        If Worksheets(2).Cells(i65, 1).Value = "" Then
        Cells(i65, 1).Interior.Color = 255
        End If
Next i65

Worksheets(2).Select

Worksheets(2).Select
For sil = [A65536].End(3).Row To 1 Step -1
If Cells(sil, "A").Interior.Color = 255 Then Cells(sil, "A").Rows.Delete 3
Next sil

lastrow20 = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("A1:A" & lastrow20).Select

    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "General"
    
Sheets(2).Activate
aa = Cells(1, 3).Value
For i40 = 2 To Range("B65536").End(3).Row
Sheets(2).Activate
aa = aa + 1
If Cells(i40, 3).Value <> aa Then
   bb = Cells(i40, 2).Value
   Sheets(1).Activate
   Application.ScreenUpdating = True
   Rows(bb).Select
   Application.DisplayAlerts = False
   Sheets(2).Delete
   Application.DisplayAlerts = True
   MsgBox bb & ".satırda hatalı tarih girişi tespit edildi.Bilgilerinizi kontrol edip makronuzu yeniden çalıştırınız."
   durum = 1
   GoTo 2000
   Else
   GoTo 1000
   End If
1000:
Next i40
Sheets(1).Activate
   Application.DisplayAlerts = False
   Sheets(2).Delete
   Application.DisplayAlerts = True
   durum = 0
2000:
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub