kalanı görme

Katılım
26 Nisan 2019
Mesajlar
16
Excel Vers. ve Dili
Office 2010
merhaba,
örnek dosyada basit stokla ilgili çalışma hazırlamak istiyorum.
giren, çıkan, kalan gibi.
sayfaya her girdiğimde ürün adına göre giren üründen çıkanı düşüp, her üründen ne kadar kaldığını görmektir.
yardımcı olabilirseniz sevinirim.

https://www.dosyaupload.com/6wgm
 
Katılım
26 Nisan 2019
Mesajlar
16
Excel Vers. ve Dili
Office 2010
merhaba,
yaptığınız dosyayın inceledim teşekkür ediyorum. lakin buna binlerce ürün listelenecek makro olması gerekiyor.
öte yandan ürünleri eklediğimde excel donma yapacaktır.
siz farklı birşeyler yapmıssınız. benim işime pek etki sağlamayacaktır.
ilginize teşekkür ederim.
 
Katılım
26 Nisan 2019
Mesajlar
16
Excel Vers. ve Dili
Office 2010
selam altın üyeliğim olmadığından dosyaya göz atamadım. rica etsem upload edebilir misiniz... iyi akşamlar.
 
Katılım
26 Nisan 2019
Mesajlar
16
Excel Vers. ve Dili
Office 2010
selam.
ilginize teşekkür ederim. stoğu listelediğimde her üründen 1 tane yerleşmesi gerekiyor. giriş ve çıkışlarda aynı satır ve tarihte aynı üründen giriş ve çıkış olmayabilir. bu nedenle ürün adına göre işlem yapması gerekiyor.
ürün adına göre tüm toplamdan yine ürün adına göre tüm toplamı çıkarıp sonucu görmek gerekiyor.
ilginize teşekkür ederim iyi çalışmalar diliyorum.
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Kod:
Private Sub CommandButton1_Click()
Set s1 = Sheets("GİREN")
Set s2 = Sheets("ÇIKAN")
Set s3 = Sheets("KALAN")
Set d = CreateObject("scripting.dictionary")

a = s1.Range("A3:E" & s1.Cells(Rows.Count, 1).End(3).Row).Value
b = s2.Range("A3:E" & s2.Cells(Rows.Count, 1).End(3).Row).Value

byt = UBound(a) + UBound(b)

ReDim c(1 To byt, 1 To 5)
    For i = 1 To UBound(a)
        krt = a(i, 2)
        If Not d.exists(krt) Then
            d(krt) = d.Count + 1
            say = d.Count
        Else
            say = d(krt)
        End If
        c(say, 1) = a(i, 1)
        c(say, 2) = a(i, 2)
        c(say, 3) = c(say, 3) + a(i, 3)
        c(say, 4) = c(say, 4) + a(i, 4)
    Next i

    For i = 1 To UBound(b)
        krt = b(i, 2)
        If Not d.exists(krt) Then
            d(krt) = d.Count + 1
            say = d.Count
        Else
            say = d(krt)
        End If
        c(say, 1) = b(i, 1)
        c(say, 2) = b(i, 2)
        c(say, 3) = c(say, 3) - b(i, 3)
        c(say, 4) = c(say, 4) - b(i, 4)
    Next i
s3.Range("A3:D" & Rows.Count) = ""
If d.Count > 0 Then
    s3.[A3].Resize(d.Count).NumberFormat = "dd.mm.yyyy"
    s3.[C3].Resize(d.Count, 2).NumberFormat = "#,##0.00"
    s3.[A3].Resize(d.Count, 4) = c
    MsgBox "İşlem tamam...", vbInformation
Else
    MsgBox "Yazdırılacak sonuç bulunamadı...", vbCritical
End If
End Sub
 
Katılım
26 Nisan 2019
Mesajlar
16
Excel Vers. ve Dili
Office 2010
teşekkür ederim elinize sağlık yalnız üründen gelmiş fakat ürün kalmamış olduğunda bile 0 sonuçları veriyor. bu olmasa da olur böyle olması da ayrı bir avantaj kalmamış ürünleri de görebilirim.
kalan sayfasında tarih sütunun olmaması gerekiyor yani
ÜRÜN ADI ADET KG
kodlarınızı okumaya çalıştım ama olmadı o kısmı kaldıramadım.
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Adet ve kg sonucu beraber 0 olanlar listelenmez.

Kod:
Private Sub CommandButton1_Click()
Set s1 = Sheets("GİREN")
Set s2 = Sheets("ÇIKAN")
Set s3 = Sheets("KALAN")
Set d = CreateObject("scripting.dictionary")

a = s1.Range("A3:E" & s1.Cells(Rows.Count, 2).End(3).Row).Value
b = s2.Range("A3:E" & s2.Cells(Rows.Count, 2).End(3).Row).Value

byt = UBound(a) + UBound(b)

ReDim c(1 To byt, 1 To 5)
    For i = 1 To UBound(a)
        krt = a(i, 2)
        If Not d.exists(krt) Then
            d(krt) = d.Count + 1
            say = d.Count
        Else
            say = d(krt)
        End If
        c(say, 1) = a(i, 1)
        c(say, 2) = a(i, 2)
        c(say, 3) = c(say, 3) + a(i, 3)
        c(say, 4) = c(say, 4) + a(i, 4)
    Next i

    For i = 1 To UBound(b)
        krt = b(i, 2)
        If Not d.exists(krt) Then
            d(krt) = d.Count + 1
            say = d.Count
        Else
            say = d(krt)
        End If
        c(say, 1) = b(i, 1)
        c(say, 2) = b(i, 2)
        c(say, 3) = c(say, 3) - b(i, 3)
        c(say, 4) = c(say, 4) - b(i, 4)
    Next i
s3.Range("B3:D" & Rows.Count) = ""
If d.Count > 0 Then
ReDim c1(1 To d.Count, 1 To 3)
    For i = 1 To d.Count
        If Not c(i, 3) = 0 Or Not c(i, 4) = 0 Then
            n = n + 1
            c1(n, 1) = c(i, 2)
            c1(n, 2) = c(i, 3)
            c1(n, 3) = c(i, 4)
        End If
    Next i
    s3.[C3].Resize(n, 2).NumberFormat = "#,##0.00"
    s3.[B3].Resize(n, 3) = c1
    MsgBox "İşlem tamam...", vbInformation
Else
    MsgBox "Yazdırılacak sonuç bulunamadı...", vbCritical
End If
End Sub
 
Üst