Sayfada 2 change olayı

[kemal turan]

merhaba,
Aşağıdaki change olayında
1 nci change olayı çalışıyor, (j3 hücresine değer girdiğimde iskonto oranınca hesaplama yapıyor.)
Fakat bold olan 2 nci change olayı çalışmıyor. (h11:h38) arasında değer girdiğimde j3 hücresine (h11:h38) arasını topluyor.
fakat bu bold olan ikinci kodu hesapla adlı kodu bağımsız çalıştırdığıma çalışyor
Worksheet_Change olayında bu 2 kodu nasıl birlikte kullanabilirm.
Teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo son
If Intersect(Target, [j3]) Is Nothing Then Exit Sub
Range("H11").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]<>"""",RC[-1]-(RC[-1]*R8C10),"""")"
    Range("H11").Select
    Selection.AutoFill Destination:=Range("H11:H38"), Type:=xlFillDefault
    Range("H11:H38").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("J11").Select
    Range("H11:H38").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J11").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("J12").Select
    
    If Not Intersect(Target, [h11:h38]) Is Nothing Then
    Range("j3").Value = Application.WorksheetFunction.Sum(Range("h11:h38"))
 
    End If
son:
Application.ScreenUpdating = True

End Sub
Sub hesapla()
Range("j3").Value = Application.WorksheetFunction.Sum(Range("h11:h38"))
End Sub

 

[kemal turan]

merhaba,
Yukarıda makro yolu ile yaptığım işlemi döngü ile halettim.
Butona bağladığım döngü ile yapılan (hesapla) işlemini change olayına bağlamak istiyorum.
Hesaplama işlemi J3 hücresi değiştiğinde olacak.

Sub hesapla()
Application.ScreenUpdating = False
Set s1 = Sheets("anasayfa")
For k = 11 To s1.Cells(38, "d").End(xlUp).Row
s1.Cells(k, "h").Value = s1.Cells(k, "g").Value - (s1.Cells(k, "g").Value * s1.Range("j8").Value)
Next k
Application.ScreenUpdating = True

End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [h11:h38]) Is Nothing Then
    Range("j3").Value = Application.WorksheetFunction.Sum(Range("h11:h38"))
     End If
End Sub

 

[Seyit Tiken]

Şu kod mantığını çalışmanıza uyarlayınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [a1:a100]) Is Nothing Then
MsgBox "1. Kod"
End If
If Not Intersect(Target, [b1:b100]) Is Nothing Then
MsgBox "2. Kod"
End If
End Sub

 

[kemal turan]

Sn.Seyit hocam
her iki kodda ortak hücre olduğundan dolayı çalışmadı.
Hesapla kodunu butona bağlayarak hallettim.
Teşekkür ederim.
Selametle kalınız.