Sipariş Formu Hazırlarken Stok Azaltma hk

[bulentkars]

Arkadaşlar Merhaba

Ekteki çalışmada sipariş formu oluşturmaktayım. Burada istediğim Ürün adını ve Revizyon numarasını seçip sipariş adedini yazdığımda Stok sayfasından seçtiğim ürün adı ve Revizyon numarasını bulup yazdığım sipariş adedini stok tan düşürmesini istiyorum.Bu konuda yardımcı olursanız sevinirim.Şimdiden Teşekkürler.

 

[Recep İpek]

Kaydet kodlarınıza aşağıdaki bölümü ilave ediniz.

Sub KaydetS()
  
    Dim bak As Range
    For Each bak In Worksheets("Sipariş").Range("B7")
        If bak.Value = "" Then
            MsgBox "Lütfen Hastane Adını seçiniz.Boş Geçemessiniz.", vbCritical, "D İ K K A T..!!!"
           
            Exit Sub
       End If
    Next bak
    
    Sheets("Sipariş").Select
    Range("B8:B21").Select
    Selection.Copy
    Worksheets("" & Worksheets("Sipariş").Range("B7") & "").Select
     
        
    Range("a1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=True
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
              SkipBlanks:=False, Transpose:=True
        ActiveCell.Select
        
    Sheets("Sipariş").Select
    
    [COLOR=navy]For i = 2 To Sheets("Stok").[a65536].End(3).Row
        If Sheets("Stok").Cells(i, "a").Value = Range("b8").Value And Sheets("Stok").Cells(i, "b").Value = Range("b10").Value Then
            Sheets("Stok").Cells(i, "d").Value = Sheets("Stok").Cells(i, "d").Value - Range("b19").Value
            Exit For
        End If
    Next i
[/COLOR]      
bilgi
temizle
End Sub

 

[Orion1]

Dosyanız ekte.

Set sh = Sheets("Stok").Range("A2:A" & Sheets("Stok").Cells(65536, "A").End(xlUp).Row)
Set k = sh.Find(Sheets("Sipariş").Range("B8").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        If k.Offset(0, 1).Value = Sheets("Sipariş").Range("B10").Value Then
            k.Offset(0, 3).Value = k.Offset(0, 3).Value - Range("B19").Value
            Exit Do
        End If
        Set k = sh.FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
End If
Set sh = Nothing
Set k = Nothing

 

[bulentkars]

Evren Bey

Yardımınız için çok teşekkür ederim elinize sağlık.

 

[bulentkars]

Evren Bey

Bir ilave yapmamız mümkünmü acaba olursa sevinirim.
Stok düşüşünde problem yoktur. Ancak stok düşüşünde istenilen miktar eldeki stoğu aşıyor ise stok yeterli değildir. uyarısınıda ekleyebilirmiyiz.

 

[Orion1]

Evren Bey

Bir ilave yapmamız mümkünmü acaba olursa sevinirim.
Stok düşüşünde problem yoktur. Ancak stok düşüşünde istenilen miktar eldeki stoğu aşıyor ise stok yeterli değildir. uyarısınıda ekleyebilirmiyiz.

Dosyanız ekte.

 

[bulentkars]

Evren Bey

Çok teşekkür ederim.Elinize sağlık

 

[Orion1]

Evren Bey

Çok teşekkür ederim.Elinize sağlık

Rica ederim.
İyi çalışmalar.