sirkülasyon
Altın Üye
- Katılım
- 10 Temmuz 2012
- Mesajlar
- 2,539
- Excel Vers. ve Dili
- 2021 LTSC TR
- Altın Üyelik Bitiş Tarihi
- 18-06-2026
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then
Set s1 = Sheets("DATA")
If Selection > 1 Then Exit Sub
If Target = "" Then Exit Sub
son = s1.Cells(Rows.Count, "B").End(3).Row
If WorksheetFunction.CountIf(s1.Range("B1:B" & son), Target) > 1 Then
MsgBox "Girilen veri birden fazla kayıt içeriyor!", vbCritical
Target.Select
Exit Sub
ElseIf WorksheetFunction.CountIf(s1.Range("B1:B" & son), Target) = 0 Then
MsgBox "Girilen veri bulunamadı!", vbCritical
Target.Select
Else
a = WorksheetFunction.Match(Target, s1.Range("B1:B" & son), 0)
Target.Offset(0, 1) = s1.Cells(a, "C")
Target.Offset(0, 2) = s1.Cells(a, "D")
Target.Offset(0, 3) = s1.Cells(a, "E")
Target.Offset(0, 4) = s1.Cells(a, "F")
Target.Offset(0, 5) = s1.Cells(a, "I")
Target.Offset(0, 7) = s1.Cells(a, "G")
End If
Else
If Not Intersect(Target, Range("H3:H50")) Is Nothing Then
sat = Target.Row
Cells(sat, "K") = WorksheetFunction.Round(Cells(sat, "H") * Sheets("Katsayılar").Range("F2"), 2)
Cells(sat, "L") = WorksheetFunction.RoundUp(Cells(sat, "J") + Cells(sat, "K"), 2)
Cells(sat, "M") = WorksheetFunction.RoundUp(Cells(sat, "H") - Cells(sat, "L"), 2)
Cells(sat, "J") = GELİR(Cells(sat, "I"), Cells(sat, "H"))
End If
End If
Exit Sub
End Sub
