Stok ve reçete takibi

[nemiroff]

Merhaba
Öncelikle burada emek veren herkese teşekkürler.
Daha önce çok faydalandım bu forumdan.
Benim sorumla ilgili birkaç saatlik arama yaptım ancak bulamadım (belki de doğru arayamadım)

Benim sizden istediğim yardım şu;
Eklemiş olduğum dosyada,

1) Satın alması yapılan ürünleri alt alta sayfaya işliyorum.
2) "STOK DURUMU" Sayfasında Üretimi yapılan ürünleri tarih tarih listeliyorum.
3) Ürünlerin reçeteleri kendi sayfasında hazır.

Benim istediğim;
*Satınalması yapılan malzemelerin toplamını kalem kalem "STOK DURUMU" sayfasına aktarmak.
*Burada ortalama ve son alış fiyatlarını ayrı sütunlarda görmek.
*Üretim yapıldıkça ilgili malzemeyi toplam stoktan düşmek.
*Reçete değişken olabileceği için ileride olası bir değişiklikte yeni reçete ekleyebilmem lazım.
*Reçete sayfalarında ürünlerin maliyet türlerine göre ve toplam maliyet olmalı.
Tavsiye edeceğiniz format vs her türlü iyileştirme ve değişiklik olabilir.

Saygılarımla

 

[caca85]

Aşağıdaki kodu denermisiniz.
İsteklerinizden "Üretim yapıldıkça ilgili malzemeyi toplam stoktan düşmek" kısmı hariç diğerlerini bu kod karşılıyor. İstediğiniz kadar kategori (KOMPONENT,PCB,DİZGİ gibi) ve yine istediğiniz kadar reçete ("ANA CİHAZ,ANTEN,SENSÖR gibi) ekleyebilirsiniz.Yine "STOK DURUMU" sayfasındaki "N" sütunu için formül atmanıza gerek yok.Makro kendi hesaplayabiliyor.(Ancak makronun hata vermemesi için "M" sütunundaki "#BAŞV!" olan kısımların düzeltilmesi lazım.Yoksa hata mesajıyla karşılaşırsınız)

"Üretim yapıldıkça ilgili malzemeyi toplam stoktan düşmek" kısmı için anladığım kadarıyla reçetelerdeki aynı kalemlerin toplamını "STOK DURUMU" sayfasındaki "M" sütununa yazdırmak istiyorsunuz. Ancak bunun için öncelikle söz konusu kalemlerin büyük-küçük harfine,noktasına ,virgülüne, karakter boşluğuna kadar kadar yazılışının aynı olması gerekebilir.Hiç düşünmedim ama bu şekilde belki yapılabilir.

Ancak anlaşılmayan kısım "STOK DURUMU" sayfasında yazan H2,I2,J2,K2,L2 hücrelerindeki 100 veya 150 olan değerlerin hangi değerlerin veya kalemlerin toplamı olacağı? Anladığım kadarıyla reçete olarak tabir ettiğiniz sayfalardaki değerler çekilecek.Yani maliyet kalemlerinde toplam maliyeti bulduğumıuz gibi toplam adet bulunup bu hücrelere mi yazılacak? Böyleyse işçilik,sarf,aksesuar gibi kategorilerin hangileri bu toplamda olacak veya olmayacak? Bunları örnekle açıklarsanız yardımcı olabilirim.

Not: Bu kod çalışıyor.Ancak dökümanınızın mantığını çok bilmediğim için,siz yine de orjinalin bir kopyasını alıp onun üzerinde deneyin.

Sub stok()

Application.ScreenUpdating = False
Sheets(2).Select
Columns("A:F").Select
Selection.Delete Shift:=xlToLeft
Columns("A:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns(1).ColumnWidth = 4.43
Columns(2).ColumnWidth = 23.71
Columns(3).ColumnWidth = 53.43
Columns(4).ColumnWidth = 12.14
Columns(5).ColumnWidth = 12.14
Columns(6).ColumnWidth = 10.57

Cells(2, 1).Value = "SIRA"
Cells(2, 2).Value = "TEDARİKÇİ"
Cells(2, 3).Value = "ÜRÜN"
Cells(1, 4).Value = "TOPLAM"
Cells(2, 4).Value = "MİKTAR"
Cells(1, 5).Value = "SON ALIŞ"
Cells(2, 5).Value = "FİYATI"
Cells(1, 6).Value = "ORTALAMA"
Cells(2, 6).Value = "BİRİM FİYAT"

Sheets(1).Select
lastrow = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'hangi sütunda olursa olsun son dolu satırı buluyor.
Range("A3:F" & lastrow).Select
Selection.Copy
Sheets(2).Select
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False

For k = 3 To Range("B65536").End(3).Row
Cells(k, 14).Value = Cells(k, 4).Value - Cells(k, 13).Value
Next k


x = Sheets.Count

For syf1 = 3 To x
Sheets(syf1).Select
Columns(13).Delete
Columns(13).Delete
Next syf1

For syf = 3 To x
Sheets(syf).Select

Range("M3:N3").Select
Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .ReadingOrder = xlContext
    End With
Cells(3, 13).Value = "MALİYET KALEMLERİ"
Cells(3, 13).Select
   With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   
Columns(13).ColumnWidth = 13
Columns(14).ColumnWidth = 13

Cells(4, 13).Value = Cells(4, 1).Value
   
Static say
say = 4
For i1 = 4 To Range("A65536").End(3).Row
   If Cells(i1, 1) = "" Then GoTo 100
   If Cells(i1, 1).Value <> Cells(i1 - 1, 1).Value Then
   say = say + 1
       For i2 = 4 To say + 1
       If Cells(i1, 1).Value = Cells(i2, 13).Value Then
       say = say - 1
       GoTo 100
       End If
       Next i2
   Cells(say, 13).Value = Cells(i1, 1).Value
   
   Else
End If
100:
Next i1

For i3 = 4 To Range("A65536").End(3).Row
    For i4 = 4 To Range("M65536").End(3).Row
    If Cells(i3, 1).Value = Cells(i4, 13).Value Then
    Cells(i4, 14).Value = Cells(i4, 14).Value + Cells(i3, 11).Value
    Else
    End If
    Next i4
Next i3

For i6 = 13 To 14
For i5 = 4 To Range("M65536").End(3).Row + 1
Cells(i5, i6).Select
   With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
   End With
   
   Cells(i5, 14).Select
   Selection.NumberFormat = _
        "_-[$$-409]* #,##0.00_ ;_-[$$-409]* -#,##0.00 ;_-[$$-409]* ""-""??_ ;_-@_ "
Next i5
Next i6

sat = Sheets(syf).[M65536].End(3).Row + 1
Cells(sat, 13).Value = "TOPLAM"
Cells(sat, 13).Select
Selection.Font.Color = 255
Selection.Font.Bold = True
Cells(sat, 14).Select
Selection.Font.Color = 255
Selection.Font.Bold = True

For i7 = 4 To Sheets(syf).[M65536].End(3).Row - 1
sat1 = Sheets(syf).[M65536].End(3).Row - 1
Cells(sat1 + 1, 14).Value = Cells(sat1 + 1, 14).Value + Cells(i7, 14).Value
Next i7

Next syf

Application.ScreenUpdating = True
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation, "                          ..:: B.UCAR ::.."

End Sub