U8 hücresi dolmadan önce AE8 hücresini boşaltıması

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Sizlerin yardımı ile bir yerlere getirebildiğim ilkokul 1 ve 2. sınıf öğrencileri için hazırladığım çalışmada yeni soruya cevap istemeden önce eski cevap noktasının boşaltılması gerekiyor.
Yardımcı olursanız çok makbule geçer. Teşekkür ederim.
Saygılarımla
Tevfik kurşun

 

[ÖmerBey]

Dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets("Çarpma").Unprotect
        
        If Intersect(Range("AE8"), Target) Is Nothing [COLOR="Red"]Or Range("AE8") = ""[/COLOR] Then Exit Sub
   
        If Target = Split(Split(Range("P4"), " = ")(0), " x ")(0) * Split(Split(Range("P4"), " = ")(0), " x ")(1) Then
            Range("AI8") = Range("AI8") + 1
            Range("M4") = Range("M4") + 1
                Else
            Range("AJ8") = Range("AJ8") + 1
        End If
            [COLOR="red"]Range("AE8") = ""[/COLOR]
            Range("I2").Select
        veri1 = 1
        veri2 = Cells(2, 9)
            For x = veri1 To veri2
                Range("I3").Value = x
            Next
    Range("AE8").Select
    Sheets("Çarpma").Protect

End Sub

 

[ÖmerBey]

Sesli uyarı da vermek için önce bir modül ekleyip içine aşağıdaki kodu yazınız.

Public Declare Function sndPlaySound32 _
    Lib "winmm.dll" _
    Alias "sndPlaySoundA" ( _
        ByVal lpszSoundName As String, _
        ByVal uFlags As Long) As Long

Sonra da yukarıdaki koda aşağıdaki ilaveleri yaparak sesli uyarı verdirebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Sheets("Çarpma").Unprotect
        
        If Intersect(Range("AE8"), Target) Is Nothing Or Range("AE8") = "" Then Exit Sub
   
        If Target = Split(Split(Range("P4"), " = ")(0), " x ")(0) * Split(Split(Range("P4"), " = ")(0), " x ")(1) Then
            Range("AI8") = Range("AI8") + 1
            Range("M4") = Range("M4") + 1
            [COLOR="Red"]Call Bildin[/COLOR]
                Else
            Range("AJ8") = Range("AJ8") + 1
            [COLOR="red"]Call Bilemedin[/COLOR]
        End If
            Range("AE8") = ""
            Range("I2").Select
        veri1 = 1
        veri2 = Cells(2, 9)
            For x = veri1 To veri2
                Range("I3").Value = x
            Next
    Range("AE8").Select
    Sheets("Çarpma").Protect

End Sub

[COLOR="Green"]Sub Bildin()
       If Application.CanPlaySounds Then
           Call sndPlaySound32("C:\Users\aaa\Desktop\alkis.wav", 0)
       End If
End Sub[/COLOR]

[COLOR="Blue"]Sub Bilemedin()
       If Application.CanPlaySounds Then
           Call sndPlaySound32("C:\Users\aaa\Desktop\yuuuh.wav", 0)
       End If
End Sub[/COLOR]

Dosya yollarını kendinize göre değiştiriniz.
Dosya uzantısının wav olmasına dikkat ediniz.

 

[Tevfik_Kursun]

Sayın Arkadaşım,
İlgi ve emekleriniz için çok teşekkür ederim. Bu çalışma gerçekten çok teknik oldu. En kısa zamanda öğrencilerin önüne çıkacak.
Başka, daha farklı çalışmalar da oluşturdum. Onlarda makro kullanımı bu kadar teknik olmadı tabii. Önemli değil, çünkü herkesi meşgul etmek hoş değil. Her ne kadar burada yaptığım çalışmalar hobiden öteye geçmeyecekse de hoşuma gidiyor ve kullanılıyor. Yeni kodlar, yeni teknikler öğrenmek başlı başına hoş bir olay.
Şöyle bir soru sorsam, excelin içinden makro rutinlerine ulaşmak mümkün mü?
Saygılarımla
Tevfik_Kursun