stok takibinde sorun

[Fuat Şirin]

ekli dosyada bir stok çalışması takibi yapması istiyorum
istediğim , sarı olan kısımlar kriter alınıyor
buna göre
girişten çıkışı çıkartacak stok sayfasında stokları göreceğim
kayıtlar bu 3 kritere göre olacak

erkek atlet / beyaz / 80

gibi

 

[Fuat Şirin]

arkadaşlar yardım edecek kimse yok mu?

 

[Mahmut Kök]

Yardımcı olmak istedim ama yanlış bir şey yapmak istemediğim için, veri içeren örnek dosya eklemenizin daha iyi olacağını düşünüyorum.

 

[Fuat Şirin]

dosya ekte

hocam dosyayı giriş yapıp ekledim manık olarak böyle
stok sayfasına her yeni ürün girildiğinde eklemesi lazım
sarı olan yerle belirttiğim gibi kriterdir

 

[Fuat Şirin]

arkadaşlar lütfen yardım edecek kimse yok mu??????

 

[Mahmut Kök]

stok sayfasının kod bölümüne yapıştırıp deneyiniz.

Private Sub Worksheet_Activate()
Set s1 = Sheets("GİRİŞ")
Set s3 = Sheets("ÇIKIŞ")
Set s2 = Sheets("STOK")
s2.Range("a2:f" & s2.[b65536].End(3).Row + 1).ClearContents
For a = 2 To s1.Range("b65536").End(3).Row
cins = s1.Cells(a, "b")
renk = s1.Cells(a, "c")
no = s1.Cells(a, "d") * 1
 
    For b = 2 To s2.Range("b65536").End(3).Row
    'MsgBox s2.Cells(b, "b") & s2.Cells(b, "c")
    If s2.Cells(b, "b") = cins And s2.Cells(b, "c") = renk And s2.Cells(b, "d") * 1 = no Then GoTo atla
    Next b
    sat2 = s2.Range("b65536").End(3).Row + 1
    s2.Cells(sat2, "b") = cins
    s2.Cells(sat2, "c") = renk
    s2.Cells(sat2, "d") = no
atla:
Next a
 
    For c = 2 To s2.Range("b65536").End(3).Row
    cins1 = s2.Cells(c, "b")
    renk1 = s2.Cells(c, "c")
    no1 = s2.Cells(c, "d") * 1
        torba1 = 0
        torba2 = 0
        miktar1 = 0
        miktar2 = 0
        For d = 2 To s1.Range("b65536").End(3).Row
            If s1.Cells(d, "b") = cins1 And s1.Cells(d, "c") = renk1 And s1.Cells(d, "d") * 1 = no1 Then
            torba1 = torba1 + (s1.Cells(d, "e") * 1)
            miktar1 = miktar1 + (s1.Cells(d, "g") * 1)
            End If
        Next
            For e = 2 To s3.Range("b65536").End(3).Row
            If s3.Cells(e, "b") = cins1 And s3.Cells(e, "c") = renk1 And s3.Cells(e, "d") * 1 = no1 Then
            torba2 = torba2 + (s3.Cells(e, "e") * 1)
             miktar2 = miktar2 + (s3.Cells(e, "g") * 1)
            End If
            Next
            s2.Cells(c, "e") = torba1 - torba2
            s2.Cells(c, "f") = miktar1 - miktar2
    Next
 
End Sub

Döngüyle yapayım dedim, biraz uzun sürdü bu şekilde ama başlamış oldum bir kere.

 

[Fuat Şirin]

hocam çok teşekkür ilgilendiğiniz için
zahmet oldu size

birde bir şeyde eklemek istiyorum çözemedim bu sorunu
comboboxta seçtiğim satırı
textboxlara almak
düzeltip aynı yerine kaydetmek istiyorum bunun için ne yapmam lazım

 

[Mahmut Kök]

Örneği inceleyiniz.

 

[Fuat Şirin]

hocam harika
tam böyle istiyordum
elinize emeğinize sağlık saygılar