Makro Çalıştırma

[serkanım]

Merhaba ,,
Aşağıdaki kodu çalıştırmam için yardımcı olabilirmisiniz.

Teşekkür ederim..


Sub sil()
Dim Target As String, alan As String

If Intersect(Target, [M2:M65000]) Is Nothing Then Exit Sub
Set alan = Range("B" & Target.Row & ":M" & Target.Row)

If Target = "" Then
alan.Interior.ColorIndex = xlNone
Else
alan.Interior.ColorIndex = 15
Range("D" & Target.Row).ClearContents
Range("E" & Target.Row).ClearContents
Range("H" & Target.Row).ClearContents
Range("I" & Target.Row).ClearContents
End If

End Sub

 

[mancubus]

kodun çalışmasını istediğiniz sayfanın kod modülüne kopyalamalısınız.

Alt+F11. sayfa ismi üzerinde çift tık. sağdaki pencereye
M sütunundaki bir hücrede değişiklik olduğu takdirde otomatik olarak yazdığınız kodlar çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim alan As [COLOR="Red"]Range[/COLOR]

If Intersect(Target, [M2:M65000]) Is Nothing Then Exit Sub
Set alan = Range("B" & Target.Row & ":M" & Target.Row)

If Target = "" Then
alan.Interior.ColorIndex = xlNone
Else
alan.Interior.ColorIndex = 15
Range("D" & Target.Row).ClearContents
Range("E" & Target.Row).ClearContents
Range("H" & Target.Row).ClearContents
Range("I" & Target.Row).ClearContents
End If

End Sub

 

[serkanım]

merhaba

bu kodları kod sayfasında değilde normal makro gibi butona basarak çalıştırabilirmiyiz acaba
teşekkür ederim..

 

[mancubus]

şimdi değişken olan satır no'nun nasıl belirleneceğine karar vermeniz lazım.

ben 2 yöntem önerdim:
1- aktif hücrenin satır numarası (bunu kullanmak isterseniz başındaki ' (tek tırnak) işaretini silip, bir alt satırın başına yazınız veya o satırı siliniz.)
2- el ile satır no girmek. (Inputbox)

Sub deneme()

    Dim alan As Range
    Dim trg As Long
    
    'trg = ActiveCell.Row
    trg = InputBox("Satır No Giriniz", "Satır")
    
    Set alan = Range("B" & trg & ":M" & trg)
    
    If Range("M" & trg) = "" Then
        alan.Interior.ColorIndex = xlNone
    Else
        alan.Interior.ColorIndex = 15
        Range("D" & trg).ClearContents
        Range("E" & trg).ClearContents
        Range("H" & trg).ClearContents
        Range("I" & trg).ClearContents
    End If

End Sub

 

[mancubus]

veya satır satır işlem yapmamayayım geniş bir alanda kodlar çalışsın isterseniz M sütunundaki en altta yer alan son dolu hücreye kadar olan alanda aşağıdaki gibi bir kod deneyebilirsiniz.
başlangıç satırı 5. bunu i = 5 satırından değiştirebilirsiniz.
en büyük satır değerinin bulunduğu sütun M değil ise bunu da ssat değişkeninden değiştirebilirsiniz.

ssat = Range("G65536").End(xlUp).Row
veya bunu da tespit edemeyecek durumda iseniz:
ssat = Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Row

Sub deneme2()

    Dim alan As Range
    Dim i As Long, ssat As Long
    
    ssat = Range("M65536").End(xlUp).Row
    
    i = 5
    Do
        Set alan = Range("B" & i & ":M" & i)
        
        If Range("M" & i) = "" Then
            alan.Interior.ColorIndex = xlNone
        Else
            alan.Interior.ColorIndex = 15
            Range("D" & i).ClearContents
            Range("E" & i).ClearContents
            Range("H" & i).ClearContents
            Range("I" & i).ClearContents
        End If
        i = i + 1
    Loop Until i = ssat + 1

End Sub

 

[serkanım]

Teşekkürler

Yazmış olduğunuz kodlar beim için yeterlidir.Yardımlarınızdan dolayı çok teşekkür ederim.

 

[mancubus]

rica ederim. kolay gelsin.