koşula bağlı olarak hücrelerin içeriğinin temizlenmesi

[meda58]

arkadaşlar bir tabloda H sütununda bir hücre içeriğini temizleyince tablo içerisinde aynı satırda sağdaki diğer hücrelerin içeriğini otomatik olarak temizleme makrosuna ihtiyaç var şimdiden çok çok teşekkürler

örneğin

tabloda H11 hücresi içeriğini temizledim tabloda aynı satırda sağdaki diğer hücrelerde temizlensin

tabloda H525 hücresi içeriğini temizledim tabloda aynı satırda sağdaki diğer hücrelerde temizlensin

bu şekilde bu sütunda devam etsin

 

[Korhan Ayhan]

Silinecek sütun aralığı belli mi?

 

[meda58]

Silinecek sütun aralığı belli mi?

evet hocam H den sonra 30 sütun yalnız aynı satır

 

[Korhan Ayhan]

Deneyiniz.

Sayfanızın kod bölümüne uygulayınız.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    
    On Error GoTo 10
    
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    For Each Rng In Target
        If Rng.Value = "" Then Rng.Resize(, 31).ClearContents
    Next
10  Application.EnableEvents = True
End Sub

 

[meda58]

Deneyiniz.

Sayfanızın kod bölümüne uygulayınız.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
   
    On Error GoTo 10
   
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
    For Each Rng In Target
        If Rng.Value = "" Then Rng.Resize(, 31).ClearContents
    Next
10  Application.EnableEvents = True
End Sub

hocam gerçekten HARİKASIN

sayın hocam bu kodun aynısını başka kitapda kullanmak üzere L-M-N sütunlarını hariçi bırakarak revize etmek mümkünmü yani diğer hepsi temizlenirken L-M-N dursun

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
   
    On Error GoTo 10
   
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
    For Each Rng In Target
        If Rng.Value = "" Then Union(Rng.Resize(, 4), Rng.Offset(, 7).Resize(, 24)).ClearContents
    Next
10  Application.EnableEvents = True
End Sub

 

[meda58]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
  
    On Error GoTo 10
  
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
  
    Application.EnableEvents = False
    For Each Rng In Target
        If Rng.Value = "" Then Union(Rng.Resize(, 4), Rng.Offset(, 7).Resize(, 24)).ClearContents
    Next
10  Application.EnableEvents = True
End Sub

hocam gerçekten HARİKASIN