Son yada F3:Ison sütunlarda değişklik olunca çalışır.Dahada hızlansın derseniz mesela D ve I sütunlarda değişiklik olarak ayarlayabilirsiniz koddaki Union(Range("A3
" & Rows.Count), Range("F3:i" & Rows.Count)) kısmı.Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Const satr As Byte = 16
Dim sonDoluSatrEtopla As Long
sonDoluSatrEtopla = Cells.Find("*", , , , , xlPrevious).Row + 1
'Application.EnableEvents = False
If Intersect(Target, Union(Range("A3" & Rows.Count), Range("F3:i" & Rows.Count))) Is Nothing Then Exit Sub
Range("L3:N" & Rows.Count).ClearContents
On Error GoTo son
With Range("L3:L1" & satr + 2)
.Formula = "=SUMIF($A$3:$A$" & sonDoluSatrEtopla & ",K3,$D$3:$D$" & sonDoluSatrEtopla & ")"
' .Formula = "=SUMIF($A$3:$A$150,K3,$D$3:$D$150)"
.Value = .Value
End With
With Range("M3:M" & satr + 2)
.Formula = "=SUMIF($F$3:$F$" & sonDoluSatrEtopla & ",K3,$I$3:$I$" & sonDoluSatrEtopla & ")"
' .Formula = "=SUMIF($F$3:$F$150,K3,$I$3:$I$150)"
.Value = .Value
End With 'Etopla sonu
ReDim arr(1 To satr, 1 To 1)
For i = 1 To satr
arr(i, 1) = Cells(i + 2, "L").Value - Cells(i + 2, "M").Value
Next
Range("N3:N" & satr + 2).Value = arr
Range("L20").Value = WorksheetFunction.Sum(Range("D3" & sonDoluSatrEtopla))
Range("L21").Value = WorksheetFunction.Sum(Range("I3:I" & sonDoluSatrEtopla))
Range("L22").Value = Range("L20").Value - Range("L21").Value
Erase arr
'Application.EnableEvents = True
Exit sub
son:
'Application.EnableEvents = True
Msgbox "hata"
End Sub
Sayfa korumalı olduğu içinde başa unprotect li kodu sonada protect li kodu ekleyin unutmuşum eklemeyi.
