Otomatik Hücre Değeri Değiştirme

[katip16487]

Ekli dosyamda VERİ-DOĞRULAMA sistemi ile yaptığım hücrelerde EVET - HAYIR yazmaktadır....

Ancak, normal şartlar altında bütün hücrelerde EVET yazmaktadır...

Yapmak istediğim bu hücrelerden herhangi birisini HAYIR diye değiştirdiğimde o hücreden itibaren o sütundaki son hücreye kadar olan verilerin hepsinin HAYIR olarak değişmesi...

B2 ile B100 hücreleri arasında işlem yapacağım.

Bütün herkese saygılar sunarım...

Forumda yaptığım aramada benzer bişey bulamadım...

Var olanlar genelde formül kopyalama sistemi ile çalışan makrolar...

[Bülent Öztürk]

Makro ile çözüm işinize yarar mı?

İlgili sayfanın adına sağ tıklayın, açılan VBA penceresinde sayfa kodlarına aşağıdakileri yapıştırın:

Kod: [Seç]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "HAYIR" Then
Application.EnableEvents = False
    b = Target.Row
    Range("B" & b + 1 & ":B100").Value = "HAYIR"
Application.EnableEvents = True
End If
End Sub

[katip16487]

Bülent Bey teşekkür ederim...

Verdiğiniz cevap işime yarayacaktır muhtemelen, ancak bir bilgiyi eksik yazdığım için çalışmadı anladığım kadarı ile...

Sayfamda,

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Satır As Integer
    If Intersect(Target, Range("J12:J131")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target <> "" Then
        Satır = Target.End(3).Row + 1
        If Satır >= Target.Row Then Exit Sub
        If Cells(Satır, Target.Column) = "" Then
            Range(Cells(Satır, Target.Column), Cells(Target.Row - 1, Target.Column)) = CDate(Target)
            Range("J12:J131").NumberFormat = "dd/mm/yyyy"
        End If
    End If
End Sub


Şeklinde kod bulunmaktadır...

Bu kodun bulunduğu sayfaya açmış olduğum konuya ilişkin kodu yerleştirmem gerekiyor...

Konu ile ilgili kodu ise çalışma sayfamda L12 ile L 131 hücreleri arasına yerleştireceğim...

Vereceğiniz bilgiler ve yapacağınız yardımlardan dolayı teşekkür ederim...

Saygılarımla...

[Bülent Öztürk]

Şu şekilde dener misiniz?

Kod: [Seç]

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Value = "HAYIR" Then
Application.EnableEvents = False
    b = Target.Row
    Range("B" & b + 1 & ":B100").Value = "HAYIR"
Application.EnableEvents = True
End If

    Dim Satır As Integer
    If Intersect(Target, Range("J12:J131")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target <> "" Then
        Satır = Target.End(3).Row + 1
        If Satır >= Target.Row Then Exit Sub
        If Cells(Satır, Target.Column) = "" Then
            Range(Cells(Satır, Target.Column), Cells(Target.Row - 1, Target.Column)) = CDate(Target)
            Range("J12:J131").NumberFormat = "dd/mm/yyyy"
        End If
    End If
End Sub