Hücredeki değeri başka bir hücreden eksiltmek

[Kavinsky]

Öncelikle merhaba,
Benim içinden 3 gündür çıkamadığım bir problem var elimde bir kod mevcut,mantıken bakınca hata da bulamadım olay şu.

bir sayfada alt alta toplanan değerlerin toplamını,başka bir yerdeki mevcut olan rakamdan düşüyor. Basitçe bir stok sistemi düşünün yani.

Range("YÖNETİM!E13").Value = Range("YÖNETİM!E13").Value - Range("CALC!D8")

Kod bu fakat problem şuradan düşerken 2 katı düşüyor Örnek vermek gerekirse mevcut stok 100 adet düşmesi gereken rakam 10 adet fakat bu kod 20 adet düşüyor ve ben işin içinden çıkamadım. Yardımlarınız için şimdiden teşekkür ederim.

 

[Muzaffer Ali]

Dosyanızı da eklerseniz hata bulunabilir.
Bu kod satırında bir sorun yok ama başka bir yerde sorun olmalı.

 

[Kavinsky]

Üstat dosya o kadar büyük ve çok veri var ki o yüzden ekleyemedim. İçinde kişisel bilgiler de çok olduğu için ekleyemedim aynı zamanda. O zaman kendi halimde çözmeye çalışacağım.

 

[Muzaffer Ali]

Bu kod Worksheet_Change olayı içerisinde mi yer alıyor?
Eğer öyleyse aşağıdaki gibi yapın.

Application.EnableEvents = False
Range("YÖNETİM!E13").Value = Range("YÖNETİM!E13").Value - Range("CALC!D8")
Application.EnableEvents = True

 

[Kavinsky]

Kod modülün içinde butona bağlı üstat. Kodun tamamı bu.

Sub YÜKLEMEGO()
Dim x1, x2 As Variant
x1 = Array("A2", "F2", "C2", "D2")
x2 = Array("ÜRÜN", "ŞİRKET", "PERSONEL", "ADET")
For Bak = 0 To UBound(x1)
If Range(x1(Bak)) = "" Then
MsgBox x2(Bak) & " GİRİŞİ EKSİK"
Exit Sub
End If
Next

'kontrol bitti
Range("CALC!O2").Value = Range("CALC!O2").Value + 1


'GFATURA NO
NoG = Sheets("PERSPEKTİF").Range("U" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("U" & NoG) = Sheets("GFATURA").[E47].Value
        
'TARİH YAPIŞTIR
NoG = Sheets("PERSPEKTİF").Range("W" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("W" & NoG) = Now
        
'Şirket Yazma
NoG = Sheets("PERSPEKTİF").Range("T" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("T" & NoG) = Sheets("GFATURA").Range("B11")

NoG = Sheets("PERSPEKTİF").Range("Y" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("Y" & NoG) = Sheets("GFATURA").Range("B11")

NoG = Sheets("PERSPEKTİF").Range("Z" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("Z" & NoG) = "GFT"
      
'FİYAT
NoG = Sheets("PERSPEKTİF").Range("V" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("V" & NoG) = Sheets("GFATURA").Range("E33")

NoG = Sheets("PERSPEKTİF").Range("X" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("X" & NoG) = Sheets("CALC").Range("G12")

   'ESAS İŞLEM BAŞLANGIÇ
 adet = Sheets("YÜKLEME").Cells(Rows.Count, 1).End(3).Row - 1
If adet > 0 Then
    Sheets("YÜKLEME").Range("A2:D" & adet + 1).Copy
        psat = Sheets("PERSPEKTİF").Cells(Rows.Count, 12).End(3).Row + 1
        Sheets("PERSPEKTİF").Cells(psat, 12).PasteSpecial Paste:=xlPasteValues
    For sat = psat To psat + adet - 1
        Sheets("PERSPEKTİF").Cells(sat, "P") = Sheets("YÜKLEME").[F2]
        Sheets("PERSPEKTİF").Cells(sat, "Q") = Now
        Sheets("PERSPEKTİF").Cells(sat, "R") = Sheets("GFATURA").[E47].Value
Range("YÖNETİM!E13").Value = Range("YÖNETİM!E13").Value - Range("CALC!D8").Value
        
        
            Next
    
    Sheets("YÜKLEME").Range("A2:A7").ClearContents
    Sheets("YÜKLEME").Range("D2:D7").ClearContents
    Sheets("YÜKLEME").[C2].ClearContents
    Sheets("YÜKLEME").[F2].ClearContents
    Sheets("YÜKLEME").[G9].Value = 0
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFiltering:=True
    MsgBox "İşleminiz tamamlanmıştır"
End If
   'ESAS İŞLEM SON
 
'BİTİR

End Sub

 

[Muzaffer Ali]

Bahsettiğini işlemi yapan satır for döngüsü içerisinde olduğundan her döngüde hesaplama yapıyor.
Sorun buradan kaynaklanıyor olabilir. Aşağıdaki şekilde düzelttim. Deneyin.

Sub YÜKLEMEGO()
Dim x1, x2 As Variant
x1 = Array("A2", "F2", "C2", "D2")
x2 = Array("ÜRÜN", "ŞİRKET", "PERSONEL", "ADET")


'kontrol bitti
Range("CALC!O2").Value = Range("CALC!O2").Value + 1


'GFATURA NO
NoG = Sheets("PERSPEKTİF").Range("U" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("U" & NoG) = Sheets("GFATURA").[E47].Value
        
'TARİH YAPIŞTIR
NoG = Sheets("PERSPEKTİF").Range("W" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("W" & NoG) = Now
        
'Şirket Yazma
NoG = Sheets("PERSPEKTİF").Range("T" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("T" & NoG) = Sheets("GFATURA").Range("B11")

NoG = Sheets("PERSPEKTİF").Range("Y" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("Y" & NoG) = Sheets("GFATURA").Range("B11")

NoG = Sheets("PERSPEKTİF").Range("Z" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("Z" & NoG) = "GFT"
      
'FİYAT
NoG = Sheets("PERSPEKTİF").Range("V" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("V" & NoG) = Sheets("GFATURA").Range("E33")

NoG = Sheets("PERSPEKTİF").Range("X" & Rows.Count).End(xlUp).Row + 1
Sheets("PERSPEKTİF").Range("X" & NoG) = Sheets("CALC").Range("G12")

   'ESAS İŞLEM BAŞLANGIÇ
 adet = Sheets("YÜKLEME").Cells(Rows.Count, 1).End(3).Row - 1
If adet > 0 Then
    Sheets("YÜKLEME").Range("A2:D" & adet + 1).Copy
        psat = Sheets("PERSPEKTİF").Cells(Rows.Count, 12).End(3).Row + 1
        Sheets("PERSPEKTİF").Cells(psat, 12).PasteSpecial Paste:=xlPasteValues
    For sat = psat To psat + adet - 1
        Sheets("PERSPEKTİF").Cells(sat, "P") = Sheets("YÜKLEME").[F2]
        Sheets("PERSPEKTİF").Cells(sat, "Q") = Now
        Sheets("PERSPEKTİF").Cells(sat, "R") = Sheets("GFATURA").[E47].Value
    Next
    'Aşağıdaki satır döngü içerisinde olduğundan kaynaklanıyor olabilir.
    'Bu satırı döngü dışına aldım.
    Range("YÖNETİM!E13").Value = Range("YÖNETİM!E13").Value - Range("CALC!D8").Value
    
    Sheets("YÜKLEME").Range("A2:A7").ClearContents
    Sheets("YÜKLEME").Range("D2:D7").ClearContents
    Sheets("YÜKLEME").[C2].ClearContents
    Sheets("YÜKLEME").[F2].ClearContents
    Sheets("YÜKLEME").[G9].Value = 0
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFiltering:=True
    MsgBox "İşleminiz tamamlanmıştır"
End If
   'ESAS İŞLEM SON
 
'BİTİR

End Sub

 

[Kavinsky]

Üstadım çok sağol problem çözüldü. Ben de sayende yeni bir şey daha öğrendim.Emeğine sağlık.