Stok kontrol çalışması hk.

Katılım
20 Mayıs 2016
Mesajlar
86
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
23-03-2024
Merhabalar,

benim 3 adet excel dosyam bulunmakta.

1)Üretim listesi
Burada üretilecek olan ürün ve adedi bilgisi bulunmakta
2)Ürün ağacı
Burada üretilecek 1 ürün için hangi malzemeler gerekli onun listesi bulunmakta
3)Stoklar
Burada ürün ağacındaki malzemelerin depo stokları bulunmakta

Yapmaya çalıştığım şey ise;
Üretim listesindeki "A1" de bulunan "Ürün Kodu" nu alıp , Ürün ağacı dosyasında bu ürün koduna bağlı kaç satır "Malzeme Türü" gerekli bunu Üretim listesi dosyasındaki "Sonuç" sayfasına her bir malzeme türü için alt alta satırlara yazdırıp, Bu malzeme türü kodlarını "Stok" dosyasında aratıp o malzemenin stoklarda kaç adet olduğunu çekmek.

Bunu çektikten sonra üretilmesi gereken adedi stoktaki malzeme adetleri karşılıyormu bunun hesabını yapmak.
Yardımcı olabilirseniz sevinirim.Farklı dosyalardan veri almak ve 1 ürün için birden fazla satırı ona bağlamak konusunu algılayamadım.Şimdiden teşekkürler

Bahsi geçen excel dosyaları ektedir.
 

Ekli dosyalar

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Üretim Listesi dosyanıza bir module ekleyip aşağıdaki kodları yapıştırın.
Kodlar çalışırken diğer iki çalışma kitabınız ( stoklar ve ürün ağacı) kapalı olmak zorunda.
Çalıştırmak için butona ya da herhangi bir olaya atayabilirsiniz.

Not:
Kodlar biraz daha kısa olabilirdi ancak farklı çalışma kitablarındaki tablolar arasında INNER yada LEFT gibi ya da onlara benzer bir birleştirme yapamadım.
Veri sayınız artıca ve performans rahatsız edici kadar düşerse tekrar bakabiliriz.


C#:
Dim Dosya As String
Dim MyCn   As Object, MyRs As Object
Sub AdoVeriAl()
    Dim Aranan As String, ifade As String
    Dim i As Integer, x As Integer
    Dim Say As Integer, TimerStart As Double
   
    TimerStart = Timer
    Son = Sheets("Sipariş").Range("A" & Rows.Count).End(xlUp).Row
    If Son < 2 Then Exit Sub

    Say = WorksheetFunction.Max(Worksheets("Sonuc").Range("A" & Rows.Count).End(3).Row + 1, 2)
    Worksheets("Sonuc").Range("A2:J" & Say).Clear
   
    Dosya = ThisWorkbook.Path & "\Ürün Ağacı.xlsx"
    Call AdoConnect
   
    For i = 2 To Son
        Aranan = Sheets("Sipariş").Range("B" & i)
        ifade = "select [Ürün Kodu],[Malzeme Türü],[Malzeme Açıklaması], [Miktar], [Birim], [SEVİYE] from [Sayfa1$]"
        ifade = ifade & " Where [Ürün Kodu] ='" & Aranan & "'"
        MyRs.Open ifade, MyCn, 1, 1
        If MyRs.RecordCount > 0 Then
            Say = Sheets("Sonuc").Range("A" & Rows.Count).End(3).Row + 1
            Sheets("Sonuc").Range("A" & Say).CopyFromRecordset MyRs
            Son = Say + MyRs.RecordCount - 1
            Sheets("Sonuc").Range("G" & Say, "G" & Son) = Sheets("Sipariş").Range("C" & i)
            For x = Say To Son
                Sheets("Sonuc").Range("H" & x) = Sheets("Sipariş").Range("C" & i) * Sheets("Sonuc").Range("D" & x)
            Next x
        End If
        MyRs.Close
    Next i
    MyCn.Close
    Set MyCn = Nothing: Set MyRs = Nothing
    Dosya = ThisWorkbook.Path & "\Stoklar.xlsx"
    Call AdoConnect

    For i = 2 To Son
        Aranan = Sheets("Sonuc").Range("B" & i)
        ifade = "select [KALAN] from [Sayfa1$] Where [KODU] ='" & Aranan & "'"
        MyRs.Open ifade, MyCn, 1, 1
        If MyRs.RecordCount > 0 Then
            Sheets("Sonuc").Range("I" & i).CopyFromRecordset MyRs
            If Sheets("Sonuc").Range("I" & i) < Sheets("Sonuc").Range("H" & i) Then
                Sheets("Sonuc").Range("J" & i) = Sheets("Sonuc").Range("H" & i) - Sheets("Sonuc").Range("I" & i)
            End If
        End If
        MyRs.Close
    Next i
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & "İşlem süresi ; " & Format(Timer - TimerStart, "0.00") & " Saniye", vbInformation
    Set MyCn = Nothing: Set MyRs = Nothing: Dosya = "": ifade = "": Aranan = ""
End Sub
Sub AdoConnect()
    Set MyCn = CreateObject("ADODB.Connection")
    Set MyRs = CreateObject("adodb.recordset")
    MyCn.Provider = "Microsoft.ACE.OLEDB.12.0"
    MyCn.Properties("Data Source") = Dosya
    MyCn.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    MyCn.Open
End Sub
 
Katılım
20 Mayıs 2016
Mesajlar
86
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
23-03-2024
Üretim Listesi dosyanıza bir module ekleyip aşağıdaki kodları yapıştırın.
Kodlar çalışırken diğer iki çalışma kitabınız ( stoklar ve ürün ağacı) kapalı olmak zorunda.
Çalıştırmak için butona ya da herhangi bir olaya atayabilirsiniz.

Not:
Kodlar biraz daha kısa olabilirdi ancak farklı çalışma kitablarındaki tablolar arasında INNER yada LEFT gibi ya da onlara benzer bir birleştirme yapamadım.
Veri sayınız artıca ve performans rahatsız edici kadar düşerse tekrar bakabiliriz.


C#:
Dim Dosya As String
Dim MyCn   As Object, MyRs As Object
Sub AdoVeriAl()
    Dim Aranan As String, ifade As String
    Dim i As Integer, x As Integer
    Dim Say As Integer, TimerStart As Double
  
    TimerStart = Timer
    Son = Sheets("Sipariş").Range("A" & Rows.Count).End(xlUp).Row
    If Son < 2 Then Exit Sub

    Say = WorksheetFunction.Max(Worksheets("Sonuc").Range("A" & Rows.Count).End(3).Row + 1, 2)
    Worksheets("Sonuc").Range("A2:J" & Say).Clear
  
    Dosya = ThisWorkbook.Path & "\Ürün Ağacı.xlsx"
    Call AdoConnect
  
    For i = 2 To Son
        Aranan = Sheets("Sipariş").Range("B" & i)
        ifade = "select [Ürün Kodu],[Malzeme Türü],[Malzeme Açıklaması], [Miktar], [Birim], [SEVİYE] from [Sayfa1$]"
        ifade = ifade & " Where [Ürün Kodu] ='" & Aranan & "'"
        MyRs.Open ifade, MyCn, 1, 1
        If MyRs.RecordCount > 0 Then
            Say = Sheets("Sonuc").Range("A" & Rows.Count).End(3).Row + 1
            Sheets("Sonuc").Range("A" & Say).CopyFromRecordset MyRs
            Son = Say + MyRs.RecordCount - 1
            Sheets("Sonuc").Range("G" & Say, "G" & Son) = Sheets("Sipariş").Range("C" & i)
            For x = Say To Son
                Sheets("Sonuc").Range("H" & x) = Sheets("Sipariş").Range("C" & i) * Sheets("Sonuc").Range("D" & x)
            Next x
        End If
        MyRs.Close
    Next i
    MyCn.Close
    Set MyCn = Nothing: Set MyRs = Nothing
    Dosya = ThisWorkbook.Path & "\Stoklar.xlsx"
    Call AdoConnect

    For i = 2 To Son
        Aranan = Sheets("Sonuc").Range("B" & i)
        ifade = "select [KALAN] from [Sayfa1$] Where [KODU] ='" & Aranan & "'"
        MyRs.Open ifade, MyCn, 1, 1
        If MyRs.RecordCount > 0 Then
            Sheets("Sonuc").Range("I" & i).CopyFromRecordset MyRs
            If Sheets("Sonuc").Range("I" & i) < Sheets("Sonuc").Range("H" & i) Then
                Sheets("Sonuc").Range("J" & i) = Sheets("Sonuc").Range("H" & i) - Sheets("Sonuc").Range("I" & i)
            End If
        End If
        MyRs.Close
    Next i
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & "İşlem süresi ; " & Format(Timer - TimerStart, "0.00") & " Saniye", vbInformation
    Set MyCn = Nothing: Set MyRs = Nothing: Dosya = "": ifade = "": Aranan = ""
End Sub
Sub AdoConnect()
    Set MyCn = CreateObject("ADODB.Connection")
    Set MyRs = CreateObject("adodb.recordset")
    MyCn.Provider = "Microsoft.ACE.OLEDB.12.0"
    MyCn.Properties("Data Source") = Dosya
    MyCn.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    MyCn.Open
End Sub
süpersiniz elinize sağlık.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
ADO/SQL de "Left Join" kullanarak hazırlanan alternatif ekte verilmiştir. Verileri almak için döngü kullanılmadığından performansı fena değildir...

Kodlarda kullanılan SQL sorgusu;

SQL:
strQuery = "Select Table1.[Ürün Kodu], " & _
           "Table2.[Malzeme Türü], Table2.[Malzeme Açıklaması], Round(Table2.[Miktar],2) As [MIKTAR], " & _
           "Table3.[BIRIM], Table2.[Seviye], Table1.[Sipariş Adedi] As [Üretim Adedi], " & _
           "[Üretim Adedi]*[MIKTAR] As [Gerekli Adet], Table3.[KALAN] As [Stok Adedi], " & _
           "IIF([Stok Adedi] Is Not Null, IIF([Gerekli Adet] > [Stok Adedi], [Gerekli Adet]-[Stok Adedi],''),[Gerekli Adet]) As [Eksik Stok]  " & _
           "From " & _
           "(" & _
               "[" & WB1 & "].[Sipariş$] As Table1 " & _
               "Left Join " & _
               "[" & WB2 & "].[Sayfa1$] As Table2 " & _
               "On Table1.[Ürün Kodu] = Table2.[Ürün Kodu]" & _
           ")" & _
           "Left Join " & _
           "[" & WB3 & "].[Sayfa1$] As Table3 " & _
           "On Table2.[Malzeme Türü] = Table3.[Kodu] Where Table2.[Malzeme Türü] Is Not Null"

.
 

Ekli dosyalar

Son düzenleme:

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Sorgunun "Eksik Stok" kontrolu kısmında bir hata vardı, yukarıdaki mesajımda yer alan sorguyu ve ekli dosyayı düzelttim.

.
 
Katılım
20 Mayıs 2016
Mesajlar
86
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
23-03-2024
Sorgunun "Eksik Stok" kontrolu kısmında bir hata vardı, yukarıdaki mesajımda yer alan sorguyu ve ekli dosyayı düzelttim.

.
Haluk Hocam selam,
şimdi sizin kodlarınızı başka bir excel dosyasına ekledim.

RS(i).Name dolu geliyor fakat RS(i).Value null geliyor.References lerden birşeyler mi seçmek lazım acaba tam olarak anlayamadığımdan size danışmak istedim.
Başlıklar geliyor.Altındaki verileri getiremedim.
 
Katılım
20 Mayıs 2016
Mesajlar
86
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
23-03-2024
Haluk Hocam selam,
şimdi sizin kodlarınızı başka bir excel dosyasına ekledim.

RS(i).Name dolu geliyor fakat RS(i).Value null geliyor.References lerden birşeyler mi seçmek lazım acaba tam olarak anlayamadığımdan size danışmak istedim.
Başlıklar geliyor.Altındaki verileri getiremedim.
Mesajı düzenleyemediğim için ekliyorum.


IIF(Table2.[Malzeme Türü] = '45.04.03' ,Table1.[Varyasyon Kodu],'') As [VKod]

sorguya yukarıdaki gibi bir if koşulu ekledim.Malzeme türü 45.04 ile başladığında(tüm kod içeriği değil başlangıç veya kodun içerisinde 45.04 geçebilir) ilgili satıra varyasyon kodunu ekletmek istiyorum.

inStr kodunu eklemeye çalıştım fakat mantık kuramadım.Yardımcı olur musunuz?
 
Üst