Çözüldü Hücre kullanımı

[Ömer Çakır]

Merhaba arkadaşlar,
Şöyle bir şey mümkün mü acaba?

C2 D2 E2 F2 G2 hücreleri için

D2 E2 F2 G2 hücrelerinin hepsinin değeri girilmeden C2 ye değer girilemez olsun

D2 E2 F2 G2 hücrelerinin herhangi birinin değeri değiştiğinde değişen hücre hariç diğer hücrelerin ( C2 D2 E2 F2 G2) içerikleri sıfırlansın

 

[MsYiLDiRiM]

ikinci şartınızda belirttiğiniz gibi eğer ben d2 hücresini değiştirirsem e2,f2,g2 hücrelerin içini silecek.
devam edip e2 hücresini değiştirirsem d2,f2,g2 hücrelerini silecek.

o zaman asla d2,e2,f2,g2 hücrelerini aynı anda dolu göremem ki nasıl c2 hücresine veri girebilecek kadar veri işleyeceğim

ilk şartınız ile alakalı olarak belki şöyle bişey olabilir. macro ile Worksheet_Calculate olayına şart koşarsınız, bu hücrelerin içeriği boş ise c2 hücresine yazzılan veriyi sil diyebilirsiniz.

 

[Ömer Çakır]

Sadece C2 D2 E2 F2 G2 bu 5 hücrenin içeriği dolu iken D2 E2 F2 G2 içerikleri değişirse o zaman değişen hücre hariç diğerlerinin içeriklerini silecek.

 

[Ömer]

Merhaba,

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim say As Byte, i As Byte
    If Intersect(Target, Range("C2:G2")) Is Nothing Then Exit Sub
    With Target
        If .Count > 1 Then Exit Sub
        say = WorksheetFunction.CountA(Range("D2:G2"))
        If .Column = 3 Then
            If say <> 4 Then
                .ClearContents
            End If
        Else
            say = WorksheetFunction.CountA(Range("C2:G2"))
            If say = 5 Then
                For i = 3 To 7
                    If .Column <> i Then
                        Cells(.Row, i).ClearContents
                    End If
                Next i
            End If
        End If
    End With
End Sub

 

[Ömer Çakır]

Merhaba,

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim say As Byte, i As Byte
    If Intersect(Target, Range("C2:G2")) Is Nothing Then Exit Sub
    With Target
        If .Count > 1 Then Exit Sub
        say = WorksheetFunction.CountA(Range("D2:G2"))
        If .Column = 3 Then
            If say <> 4 Then
                .ClearContents
            End If
        Else
            say = WorksheetFunction.CountA(Range("C2:G2"))
            If say = 5 Then
                For i = 3 To 7
                    If .Column <> i Then
                        Cells(.Row, i).ClearContents
                    End If
                Next i
            End If
        End If
    End With
End Sub

Teşekkürler Ömer Bey, C D E F G hücrelerini değiştirdiğimde içeriği siliyor ama C ye dğer girmeden diğer hücrelerin hepsi dolu değilse aşağıdaki şekilde hata veriyor ve sayfayı kapatıyor. Hata vermesin ama hücreye değer de girmesin, yada hata vermek yerine ekrana uyarı mesajı gelsin "D E F G" hücrelerine değer girilmeden C hücresine değer girilemez" şeklinde.

 

[Ömer]

Bende hata vermemişti, hata veren örneği ekleyebilir misiniz.

 

[Ömer Çakır]

Bende hata vermemişti, hata veren örneği ekleyebilir misiniz.

Sarı hücrelerin tamamı dolu değilken turuncuya değer girersem aşağıdaki hatayı veriyor. Debug tuşuna basarsam bir önceki gönderide yüklediğim resimdeki gibi VBA ekranını açıyor. End dersem aşağıdaki resimdeki hata penceresi kapanıyor ama turuncu hücreye tekrar değer girersem bu sefer dosyayı kapatıyor. Dosyayı ekledim.

 

[Ömer]

Bende bir hata vermedi. Akşam hata nedeni araştırıp 365 sürüm ile deneyip dönüş yaparım.

 

[Ömer Çakır]

Bende bir hata vermedi. Akşam hata nedeni araştırıp 365 sürüm ile deneyip dönüş yaparım.

Ömer Bey, Office 2007 de denedim orda evet dediğiniz gibi hata vermiyor. Ben kendi bilgisayarımda Office 365 kullanıoyorum ama arkadaşlarla ortak kullandığımız iş bilgisayarında Ofis 2007 var.
Birde Ofis 2007 de yukarıda yazdığınız kodu birden çok satıra uyarlamaya çalıştım, başaramadım.

Rica etsem mümkünse 2 nolu satır için uyguladığımız bu işlerin aynısını ardışık devam eden 27 satıra kadar uygulayabilir miyiz lütfen.

 

[Ömer]

365 bende de hata verdi. Kodu düzelttim. Aşağıdaki gibi hata vermiyor. Ayrıca aralığı da genişlettim.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim say As Byte, i As Byte
    On Error GoTo 10
    If Intersect(Target, Range("C2:G27")) Is Nothing Then Exit Sub
    With Target
        If .Count > 1 Then Exit Sub
        Application.EnableEvents = False
        say = WorksheetFunction.CountA(Range(Cells(.Row, "D"), Cells(.Row, "G")))
        If .Column = 3 Then
            If say <> 4 Then
                .ClearContents
            End If
        Else
            say = WorksheetFunction.CountA(Range(Cells(.Row, "C"), Cells(.Row, "G")))
            If say = 5 Then
                For i = 3 To 7
                    If .Column <> i Then
                        Cells(.Row, i).ClearContents
                    End If
                Next i
            End If
        End If
    End With
10 Application.EnableEvents = True
End Sub

 

[Ömer Çakır]

365 bende de hata verdi. Kodu düzelttim. Aşağıdaki gibi hata vermiyor. Ayrıca aralığı da genişlettim.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim say As Byte, i As Byte
    On Error GoTo 10
    If Intersect(Target, Range("C2:G27")) Is Nothing Then Exit Sub
    With Target
        If .Count > 1 Then Exit Sub
        Application.EnableEvents = False
        say = WorksheetFunction.CountA(Range(Cells(.Row, "D"), Cells(.Row, "G")))
        If .Column = 3 Then
            If say <> 4 Then
                .ClearContents
            End If
        Else
            say = WorksheetFunction.CountA(Range(Cells(.Row, "C"), Cells(.Row, "G")))
            If say = 5 Then
                For i = 3 To 7
                    If .Column <> i Then
                        Cells(.Row, i).ClearContents
                    End If
                Next i
            End If
        End If
    End With
10 Application.EnableEvents = True
End Sub

Ömer Bey, teşekkür ederim. Elinize, emeğinize sağlık.