Silinmiş Hücre için MsgBox Uyarısı

[hakki83]

Selamlar


A2 ile A10000 arası sırayla tarihler yazılı.

Eğer yanlışlıkla bu tarihlerden bir veya birden fazlası yanlışlıkla silinirse,

Activate olayında MsgBox ile " ........ Hücre-Hücrelerdeki Tarihler Yanlışlıkla Silinmiş, Düzeltiniz"

uyarısı verdirebilir miyiz?

Silinmiş bir tarih yoksa, herhangi bir uyarı vermeyecek.

(Not: Sayfayı Koru özelliğini bu dosyada kullanmıyorum)

 

[Korhan Ayhan]

Bu şekilde işinize yarar mı?

Private Sub Worksheet_Activate()
    If WorksheetFunction.CountBlank(Range("A2:A10000")) > 0 Then
        MsgBox "Bazı tarihlerin silindiği tespit edildi. Lütfen düzeltiniz.", vbCritical
    End If
End Sub

 

[dEdE]

Alternatif

Private Sub Worksheet_Activate()
    ss = Cells(Rows.Count, "A").End(3).Row - 1
    For Each Hücre In Range("A2:A" & ss)
        If Hücre = "" Then
            Satır = Satır & "-" & "A" & Hücre.Row
        End If
    Next
    If Satır <> "" Then _
    MsgBox Satır & vbCrLf & " Hücrelerindeki Tarihler Yanlışlıkla Silinmiş, Düzeltiniz", vbCritical, "D İ K K A T !!!"
End Sub

 

[Korhan Ayhan]

Ek bilgi...

Eğer ilgili alanda silinmiş hücre sayısı çoksa MSGBOX hepsinin adresini görüntülemek için yetersiz kalacaktır.

 

[hakki83]

Emekleriniz için teşekkürler değerli hocalarımız.
Kodlar gayet güzel.

 

[dEdE]

Ek bilgi...
Eğer ilgili alanda silinmiş hücre sayısı çoksa MSGBOX hepsinin adresini görüntülemek için yetersiz kalacaktır.

Korhan Ayhan Hocam,
Bu durumun farkındaydım ama, sayfaya veya UserForm'a yazdırmaktan başka çözüm bulamadım.
Farklı önerileriniz olur mu?

 

[Korhan Ayhan]

Silinen hücre adreslerinin görütülenmesi önem taşıyorsa sizin belirttiğiniz çözümlerek ek olarak MSGBOX'ta veriler parçalanarak gösterilebilir.

Ben olsam bu aşamaya gelmeden hücrelere doğru veri girilmesi konusuna odaklanırdım. Böylece sonradan çıkabilecek sorunların önüne geçmiş olursunuz. İlgili verinin silinmesi risk yaratıyorsa sayfa koruması kullanılarak önlem alınabilir.

 

[Korhan Ayhan]

Verilerin MSGBOX'ta parçalı şekilde görüntülenmesi ile hazırladığım örnek kod aşağıdadır. Belki kullanmak isteyen olabilir. Forumun arşivinde bulunsun.

Option Explicit

Private Sub Worksheet_Activate()
    Dim My_Data As Variant, My_Date As Date, X As Long, Y As Long
    Dim Z As Long, My_Check_1 As Boolean, My_Check_2 As Boolean
    
    My_Data = Range("A2:A10000").Value
    My_Date = CDate("01.01.2022")
    ReDim My_List(1 To 1)
    ReDim My_Message(1 To 1)
    
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        If My_Date + X - 1 <> My_Data(X, 1) Then
            My_Check_1 = True
            Y = Y + 1
            ReDim Preserve My_List(1 To Y)
            My_List(Y) = "A" & X + 1
            If Y < 50 Then
                If My_Check_2 = True Then My_Check_1 = False
            End If
            If Y > 50 Then
                My_Check_2 = True
                Z = Z + 1
                ReDim Preserve My_Message(1 To Z)
                My_Message(Z) = Join(My_List, vbCrLf)
                Y = 0
                Erase My_List
            End If
        End If
    Next

    If My_Check_1 = True Then
        MsgBox "Aşağıdaki hücrelerde tarihlerde sorun tespit edildi. Lütfen düzeltiniz." & _
               vbCrLf & vbCrLf & Join(My_List, vbCrLf), vbCritical
    End If
    
    If My_Check_2 = True Then
        For X = LBound(My_Message) To UBound(My_Message)
            MsgBox "Aşağıdaki hücrelerde tarihlerde sorun tespit edildi. Lütfen düzeltiniz." & _
                   vbCrLf & vbCrLf & My_Message(X), vbCritical
        Next
    End If
End Sub