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

Katılım
5 Şubat 2016
Mesajlar
274
Excel Vers. ve Dili
Office 365 Türkçe
Ö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.
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Dosyanızı da eklerseniz hata bulunabilir.
Bu kod satırında bir sorun yok ama başka bir yerde sorun olmalı.
 
Katılım
5 Şubat 2016
Mesajlar
274
Excel Vers. ve Dili
Office 365 Türkçe
Ü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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Bu kod Worksheet_Change olayı içerisinde mi yer alıyor?
Eğer öyleyse aşağıdaki gibi yapın.

Kod:
Application.EnableEvents = False
Range("YÖNETİM!E13").Value = Range("YÖNETİM!E13").Value - Range("CALC!D8")
Application.EnableEvents = True
 
Katılım
5 Şubat 2016
Mesajlar
274
Excel Vers. ve Dili
Office 365 Türkçe
Kod modülün içinde butona bağlı üstat. Kodun tamamı bu.

Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
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.

Kod:
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
 
Katılım
5 Şubat 2016
Mesajlar
274
Excel Vers. ve Dili
Office 365 Türkçe
Üstadım çok sağol problem çözüldü. Ben de sayende yeni bir şey daha öğrendim.Emeğine sağlık.
 
Üst