Boş Olan Hücre Uyarısı

[shiva]

Merhaba Arkadaşlar,

Öyle bir işlem istiyorum ki C2 de (C Sütunuda diyebiliriz) yer alan combobox'tan "Kazanıldı" seçildiğinde I2-J2-K2 (I-J-K Sütunları) hücreleri mutlaka doldurulsun. Doldurulmadan save edilmeye çalışıldığında boş olan hücrenin doldurulması gerektiği bilgisi pop-up olarak ekrana gelsin.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim son
son = Cells(65500, 3).End(xlUp).Row
For i = 1 To son
If Cells(i, 3).Value = "Kazanıldı" Then
If Cells(i, 9) = "" Then
Cells(i, 9).Select
MsgBox "I" & i & " hücresi boş olduğundan kayıt yapılamıyor"
Cancel = True
End
End If
If Cells(i, 10) = "" Then
Cells(i, 10).Select
MsgBox "J" & i & " hücresi boş olduğundan kayıt yapılamıyor"
Cancel = True
End
End If
If Cells(i, 11) = "" Then
Cells(i, 11).Select
MsgBox "K" & i & " hücresi boş olduğundan kayıt yapılamıyor"
Cancel = True
End
End If
End If
Next

End Sub

Bu işlem için Kulomer46 arkadaşım yukarıdaki gibi makro hazırladı sağolsun. Ancak benim söylemeyi unuttuğum bir şey var. İzmir 1, İzmir 2, Ankara 1 ve Ankara 2 olmak üzere 4 farklı sheet'im var. Mesela ankara 1 sheetinde ı j k hücrelerinden birini boş bırakıp, diğer bir sheete geçtiğimde save edilebiliyor.

Farklı bir sheete bile geçsek save etmeye çalıştığımızda ekrana gelen uyarıda hem sheetin ismi hem de hücre ismi (boş olan sheetin ve hücrenin) yer alabilir mi?


P.S: Dosyanın tüm C sütununa uygulamak istiyorum.

Konu hakkında yardımlarınız için şimdiden teşekkürler.


İyi çalışmalar.


Engin
__________________

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Kullandığınız hücre sayısı arttıkça sorgulama uzun sürecektir. Bu sebeple yavaşlama olabilir.

Siz makroyu denemek için sayfalarda "Kazanıldı" yazan kelimelerin I-J-K sütunlarındaki verileri silerek dosyayı kaydetmeye çalışın.

 

[shiva]

Arkadaşım çok saol ama sizin gönderdiğin eklentileri açtığımda makroları göremiyorum. 2007 versiyondan olabilir. Rica etsem makroyu buraya yazabilir misiniz?

Çok teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu deneyiniz.

Option Explicit
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sayfa As Object
    Dim Say As Long, X As Long, Mesaj As String
    Say = 0
    For Each Sayfa In Worksheets
        With Sayfa
        For X = 2 To .Cells(65536, 3).End(3).Row
            If .Cells(X, 3) = "Kazanıldı" Then
                If .Cells(X, "I") = "" Then Mesaj = Mesaj & Chr(10) & Sayfa.Name & "   " & Cells(X, "I").Address(0, 0)
                If .Cells(X, "J") = "" Then Mesaj = Mesaj & Chr(10) & Sayfa.Name & "   " & Cells(X, "J").Address(0, 0)
                If .Cells(X, "K") = "" Then Mesaj = Mesaj & Chr(10) & Sayfa.Name & "   " & Cells(X, "K").Address(0, 0)
                If Mesaj <> "" Then Say = Say + 1
            End If
        Next
        End With
    Next
 
    If Say > 0 Then
    Cancel = True
    MsgBox "Sayfalarda bo&#351; h&#252;creler bulundu kay&#305;t i&#351;lemi iptal edilmi&#351;tir." & Chr(10) & _
    "L&#252;tfen kontrol ediniz !" & Chr(10) & Mesaj, vbCritical, "Dikkat !"
    Else
    Cancel = False
    End If
End Sub

Not: Eğer 2007 versiyonunu kullanıyorsanız imzanızda yada profilinizde belirtin ki yardımcı olan arkadaşlar cevap verirken ona göre versinler.

 

[shiva]

şimdi değiştirdim imzamı. makroda süper oldu. ellerinize sağlık. çok teşekkürler.

 

[shiva]

Sayın Korhan Ayan,
C sütununu E olarak ve ı-j-k sütunlarınıda da K-L-M olarak nasıl değiştirebilriz? Bir de sayfa sayım 4 ten 9 a cıktı. Onlarında ismi değişti. İstanbul 1-2-3 ... 9 a kadar gidiyor. makro bilgim olmadığı için ben dosyada gerekli değşiklikleri yapamadım. Yardımlarınız için şimdiden teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu deneyin. Değişiklik yaptığım bölümleri kırmızı renkle belirttim.

[LEFT]Option Explicit
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sayfa As Object
    Dim Say As Long, X As Long, Mesaj As String
    Say = 0
    For Each Sayfa In Worksheets
        With Sayfa
        For X = 2 To .Cells(65536, [COLOR=red]5[/COLOR]).End(3).Row
            If .Cells(X, [COLOR=red]5[/COLOR]) = "Kazanıldı" Then
                If .Cells(X, "[COLOR=red]K[/COLOR]") = "" Then Mesaj = Mesaj & Chr(10) & Sayfa.Name & "   " & Cells(X, "[COLOR=red]K[/COLOR]").Address(0, 0)
                If .Cells(X, "[COLOR=red]L[/COLOR]") = "" Then Mesaj = Mesaj & Chr(10) & Sayfa.Name & "   " & Cells(X, "[COLOR=red]L[/COLOR]").Address(0, 0)
                If .Cells(X, "[COLOR=red]M[/COLOR]") = "" Then Mesaj = Mesaj & Chr(10) & Sayfa.Name & "   " & Cells(X, "[COLOR=red]M[/COLOR]").Address(0, 0)
                If Mesaj <> "" Then Say = Say + 1
            End If
        Next
        End With
    Next
 
    If Say > 0 Then
    Cancel = True
    MsgBox "Sayfalarda bo&#351; h&#252;creler bulundu kay&#305;t i&#351;lemi iptal edilmi&#351;tir." & Chr(10) & _
    "L&#252;tfen kontrol ediniz !" & Chr(10) & Mesaj, vbCritical, "Dikkat !"
    Else
    Cancel = False
    End If
End Sub

[/LEFT]