Stok Takip Programı

[aptillah]

Merhabalar ,

Ekte sunduğum dosyadada açıkladım. Yapmak istediğim şey veri sayfasında olan ürünlerin hangi mağazada olduğunun d sütununa yazdırılması. bir çok mağaza olduğundan e sütunundan başlayarak kontrol edip ilk hangi mağazada bulursa mağağzanın ismini d sütununa yazılmasını istiyorum .. Yardımlarınızı bekliyorum..
https://www.dosyaupload.com/b99v

 

[PLİNT]

Merhaba
Aşağıdaki formülü "D2" hücresine yazarak denermisiniz?

=HÜCRE("içerik";DOLAYLI(ADRES(1;4+TOPLA.ÇARPIM(KAÇINCI(1;--(E2:Z2>0);0)))))

 

[aptillah]

Teşekkürler tam istediğim gibi olmuş.. Bir sorum olacak unu makro ile yapmak mümkün mü acaba ?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Magaza_Bul()
    Dim Liste As Variant, X As Long, Son As Long, Bul As Integer, Formul As String
   
    Son = Cells(Rows.Count, 2).End(3).Row
    Liste = Range("B2:B" & Son).Value
   
    Range("D2:D" & Rows.Count).ClearContents
   
    For X = LBound(Liste) To UBound(Liste)
        Formul = "MIN(IF(E" & X + 1 & ":AZ" & X + 1 & "<>0,COLUMN(E" & X + 1 & ":AZ" & X + 1 & ")))"
        Bul = Evaluate(Formul)
        If Bul > 0 Then
            Cells(X + 1, 4) = Cells(1, Bul)
        Else
            Cells(X + 1, 4) = "Yok"
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation  
End Sub

 

[aptillah]

çok teşekkür ederim ellerinize sağlık

 

[aptillah]

Merhabalar,
Konu ile ilgili bir sorum daha olacaktı.Verdiğiniz kod ile hangi ürün hangi mağazada yazdırabiliyorum. Fakat ürünlerin stoğununda değişmesi mümkün müdür anlık olarak bu makro çalışırken.

 

[Korhan Ayhan]

Stok neye göre değişecek!

 

[aptillah]

Merhabalar Korhan bey,

Dosya ilk mesajda mevcut. Örnek verecek olursam, İlk ürün estore mağaza da bir tane gözüküyor.İkinci üründe aynı lokasyonlar yazdırılırken aynı anda stok düşümü sağlayabiliyormuyuz mağazalar baz alınarak

  
    

​

​

​

​

​

 

[Korhan Ayhan]

Ben anladığımı yazayım.

D2 hücresi için "e store" yazdırdık. E2 hücresindeki 1 değeri 1 azalacak.

İstediğiniz işlem bu şekilde mi? Talebiniz farklı ise hücre adresleri vererek örneklendiriniz.

 

[aptillah]

korhan bey dediğiniz gibi D2 hücresi için "e store" yazdırdık. E2 hücresindeki 1 değeri 1 azalacak fakat d2 hücresinde olan barkod numarasından başka hücrede de var ise onun da stoğundan düşmesi lazım çünkü aynı ürün. Bu dediğimi tek sayfada yapmak mümkün mü ?

 

[Korhan Ayhan]

Dediğim gibi benzer barkod içeren küçük bir dosyada elimdeki tablo bu olmasını istediğim sonuç bu şeklinde örneklendirirseniz daha hızlı sonuç alabilirsiniz

 

[aptillah]

Korhan bey dosyayı ekledim içine de açıklamayı yazdım.

veri.xlsm

dosyayı indir, full download - veri.xlsm

www.dosyaupload.com

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton1_Click()
  Dim Liste As Variant, X As Long, Son As Long, Bul As Integer, Formul As String
   
    Son = Cells(Rows.Count, 2).End(3).Row
    Liste = Range("B2:B" & Son).Value
   
    Range("F2:F" & Rows.Count).ClearContents
   
    For X = LBound(Liste) To UBound(Liste)
        Formul = "MIN(IF(G" & X + 1 & ":AZ" & X + 1 & "<>0,COLUMN(G" & X + 1 & ":AZ" & X + 1 & ")))"
        Bul = Evaluate(Formul)
        If Bul > 0 Then
            Cells(X + 1, 6) = Cells(1, Bul)
            Cells(X + 1, Bul) = Cells(X + 1, Bul) - 1
        Else
            Cells(X + 1, 6) = "Yok"
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[aptillah]

Korhan hocam ilginiz için teşekkürler. Stok düşüyor ama dediğim gibi eğer ürün aynı ise onlar güncellenmiyor.
Örnek ; Alttaki 3 üründe aynı ürün ben 1. ürünün stoğu düştüğünde diğerlerinin de güncellenmesini istiyorum.
1. ürün stok 5
2. ürün stok 5
3. ürün stok 5

 

[Korhan Ayhan]

Bir de bu kodu deneyiniz.

Private Sub CommandButton1_Click()
  Dim Liste As Variant, X As Long, Son As Long, Bul As Integer
  Dim Formul As String, Barkod As Range, Adres As String
   
    Son = Cells(Rows.Count, 2).End(3).Row
    Liste = Range("B2:B" & Son).Value
   
    Range("F2:F" & Rows.Count).ClearContents
   
    For X = LBound(Liste) To UBound(Liste)
        Formul = "MIN(IF(G" & X + 1 & ":AZ" & X + 1 & "<>0,COLUMN(G" & X + 1 & ":AZ" & X + 1 & ")))"
        Bul = Evaluate(Formul)
        If Bul > 0 Then
            Cells(X + 1, 6) = Cells(1, Bul)
            Cells(X + 1, Bul) = Cells(X + 1, Bul) - 1
            Set Barkod = Range("D" & X + 2 & ":D" & Rows.Count).Find(Cells(X + 1, "D"), , , xlWhole)
            If Not Barkod Is Nothing Then
                Adres = Barkod.Address
                Do
                    Cells(Barkod.Row, Bul) = Cells(Barkod.Row, Bul) - 1
                    Set Barkod = Range("D" & X + 2 & ":D" & Rows.Count).FindNext(Barkod)
                Loop While Not Barkod Is Nothing And Barkod.Address <> Adres
            End If
        Else
            Cells(X + 1, 6) = "Yok"
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[aptillah]

Korhan Hocam istediğim gibi olmadı ben biraz uğraşarak şöyle bir kod ekledim bunda istediğim oluyor fakat şöyle bir sıkıntı var.
Aşşağıda ki gibi ilk üründen sadece 1 düşüyor diğerleri normal olarak güncel stok şeklinde düşüyor ama ilk ürün adedi kaç ise bir düşüğünde kalıyor.
Sizce koddaki sorun nedir ?

ürünler aynı ürün stok adedi de 3
ürün stok adedi : 2
ürün stok adedi :0
ürün stok adedi :0

Private Sub CommandButton1_Click()
   Dim Liste As Variant, X As Long, Son As Long, Bul As Integer, Formul As String
  
    Son = Cells(Rows.Count, 1).End(3).Row
    Liste = Range("b2:d" & Son).Value
  
    Range("F2:F" & Rows.Count).ClearContents
  
    For X = LBound(Liste) To UBound(Liste)
        Formul = "MIN(IF(G" & X + 1 & ":AZ" & X + 1 & "<>0,COLUMN(G" & X + 1 & ":AZ" & X + 1 & ")))"
        Bul = Evaluate(Formul)
        If Bul > 0 Then
            Cells(X + 1, 6) = Cells(1, Bul)
            Cells(X + 1, Bul) = Cells(X + 1, Bul) - 1
          sonsatir = Sheets("veri").Range("d65536").End(3).Row
        For i = 1 To sonsatir
        If WorksheetFunction.CountIf(Range("d1:d" & i), Range("d" & i).Value) > 1 Then
        Cells(d & i, Bul) = Cells(X + 1, Bul)
        End If
  Next i
  i = 0
        Else
            Cells(X + 1, 6) = "Yok"
        End If
      
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Korhan Ayhan]

Önerdiğim kod da olmayan yeri tarif ederseniz düzenlemeye çalışırım.

 

[aptillah]

Korhan bey kodda olan sıkıntı hem stoklar 0 altına düşüyor hemde sıfırın altına düşse de mağaza ismini yazıyor. Birde stokları güncellemiyor istediğim gibi.Şötle olması gerek 1 ürün ve 5. ürün aynı barkoda sahipbu üründe estore da 2 tane var.Kodun işlemi bittiğinde 1. ve 5 . ürün karşısında estore bölümde stokların 0 olması gerekiyor ama kod bunu yapmıyor