change olayında hata

[ozgur1122334455]

arkadaşalar merhaba

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub

If Target.Cells = "" Then
Target.Offset(0, 1) = ""
Else
If Target.Cells.Value = "a" Or _
Target.Cells.Value = "b" Then
Target.Offset(0, 1) = "OK"


End If
End If
End Sub

yukarıda verdiğim kodlar istediğim gibi çalışıyor ancak birden fazla hücrede aynı anda değişiklil yaptığımda (değiştirdiğimde veya sildiğimde) hata veriyor yardımcı olabilecek bir arkadaş olursa çok sevinirim. şimdiden teşekkürler..

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells = "" Then
        Target.Offset(0, 1) = ""
    Else
        If Target.Cells.Value = "a" Or _
            Target.Cells.Value = "b" Then
            Target.Offset(0, 1) = "OK"
        End If
    End If
Son:
End Sub

 

[ozgur1122334455]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells = "" Then
        Target.Offset(0, 1) = ""
    Else
        If Target.Cells.Value = "a" Or _
            Target.Cells.Value = "b" Then
            Target.Offset(0, 1) = "OK"
        End If
    End If
Son:
End Sub

maalesef bu şekilde hata vermiyor ancak kod toplu şekilde çalışmıyor

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Dim A As Range, B As Range, Alan As Range, Veri As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Alan Is Nothing Then
        On Error Resume Next
        Set A = Columns("A:A").SpecialCells(xlCellTypeConstants, 23)
        Set B = Columns("A:A").SpecialCells(xlCellTypeFormulas, 23)
        If A Is Nothing Then
            Set Alan = B
        ElseIf B Is Nothing Then
            Set Alan = A
        Else
            Set Alan = Union(A, B)
        End If
        On Error GoTo 0
    End If
    If Alan Is Nothing Then GoTo Son
    For Each Veri In Alan
        If Veri.Column = 1 Then
            If Veri.Value = "" Then
                Veri.Offset(0, 1) = ""
            Else
                If Veri.Value = "a" Or Veri.Value = "b" Then Veri.Offset(0, 1) = "OK"
            End If
        End If
    Next
Son:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    Set A = Columns("A:A").SpecialCells(xlCellTypeConstants, 23)
    Set B = Columns("A:A").SpecialCells(xlCellTypeFormulas, 23)
    If A Is Nothing Then
        Set Alan = B
    ElseIf B Is Nothing Then
        Set Alan = A
    Else
        Set Alan = Union(A, B)
    End If
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

 

[ozgur1122334455]

ilginize teşekkürler ancak çoklu silme yaptığımızda b sütununda ki veriler silinmiyor.

 

[Korhan Ayhan]

Merhaba,

Çoklu veri silme işlemini nasıl yapıyorsunuz?

Ben "A" sütununu seçip DELETE tuşuna bastığımda "B" sütunundaki verilerde siliniyor.

Her ihtimale karşı üstteki mesajımda ki koda küçük eklemeler yaptım. Son halini deneyiniz.

 

[ozgur1122334455]

örneğin a2-a10 araını seçip del yapınca b sütunundaki b2-b10 silinmiyor.

 

[ozgur1122334455]

sizden daha öncede benzer bir konuda yardım almıştım.
http://www.excel.web.tr/f14/otomatik-tarih-ve-saat-hk-t151471.html

buradaki gibi olsun ancak tarih saat yerine benim istediklerim yazsın istiyorum.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        If Target.Value = "" Then
            Target.Offset(0, 1) = ""
        Else
            If Target.Value = "a" Or Target.Value = "b" Then Target.Offset(0, 1) = "OK"
        End If
    Else
        For Each Veri In Selection
            If Veri.Column = 1 Then
                If Veri.Value = "" Then
                    Veri.Offset(0, 1) = ""
                Else
                    If Veri.Value = "a" Or Veri.Value = "b" Then Veri.Offset(0, 1) = "OK"
                End If
            End If
        Next
    End If
End Sub

 

[ozgur1122334455]

ellerinize şağlık tam istediğim gibi ben 2 gündür uğraşıp üzerinde değişiklik yapıp düzeltememiştim. çok sağolun teşekkürler..