ÜRÜN REÇETE ÇALIŞMA

[Mukteda]

.
Selamlar,
Ürün reçetelerinin içerisindeki hammaddeleri depodan almak için form oluşturulması gerekiyor.
Bir reçete kodu yazıldığında kaç adet ürün için olacak ise bu şekilde raporlama yapacaktır.
Olması gerekenleri ekli dosyada yazdım.
Yardımcı olabilir misiniz?
Teşekkürler.

http://s2.dosya.tc/server8/l13cty/RECETE_CALISMA.xlsx.html

 

[PriveT]

Merhaba,
Linkteki dosyayı deneyiniz.

https://dosya.co/paui8rzmznhc/RECETE_CALISMA.xlsx.html

 

[Mukteda]

.
Merhaba
İlginiz ve yardımınız için çok teşekkür ederim.
Bu sorunu makro VBA ile çözebilir miyiz?
Daha doğru, daha stabil çalışacaktır.
Örnek: Formda satır sayısı 43 ancak reçetedeki hammadde sayısı ise 100 satırdır. VBA ile 100 satır oluşması sağlanabilir.

 

[PriveT]

Merhaba,
Yetmediği yerde son satırı aşağı doğru sürükleyerek istediğiniz kadar çoğaltabilirsiniz.
Bununla uğraşmak istemeyip illa da Makro derseniz maalesef ben makronun M'sinden anlamıyorum. Forumda konunun uzmanları var yardımcı olabilecek.

 

[veyselemre]

Sub adoRecete()
    Sheets("001").Select
    malzeme = [L4]
    miktar = [L6]
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & ThisWorkbook.FullName & _
             "';Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"

    strsql = "SELECT F3, (" & miktar & "*F5), F4,null,null,null,null, F5 " & _
             "FROM [VERI$A2:E" & Sheets("VERI").Cells(Rows.Count, 3).End(3).Row & "] " & _
             "WHERE F1='" & malzeme & "'"

    Set RS = CreateObject("Adodb.RecordSet")
    RS.Open strsql, strCon

    Range("B4:I43").ClearContents
    Range("B4").CopyFromRecordset RS
    RS.Close
End Sub

 

[Mukteda]

Merhaba

İlginize ve yardımlarınıza çok çok teşekkür ederim.

Başarılar, kolay gelsin.

 

[PriveT]

Teşekkürler, iyi günler.

 

[Mukteda]

Sub adoRecete()

Selamlar,
Değerli ilginiz ve desteğiniz için teşekkür ederim.
Vermiş olduğunuz kod çalıştı, Sağ olun.
Aşağdaki düzeltmeleri de tamamlayabilir miyiz?
"Ürün Reçetesi Kodu:" Buraya yazıp butona tıklamak yerine aşağıya açılır menü olsa ve buradan seçtiğimizde sol taraftaki tablo otomatik oluşabilir mi?
Bazen uzun 100-150 satır reçete malzemeleri oluyor. Bunlar sayfaya ve tabloya sığmıyor. Dosyadaki 44,45,46 satırlar reçete satırları oluşturulduktan sonra en alta gelebilir mi?
En son olarakta E46'ya günün tarihi yazılabilir mi?

 

[muygun]

Merhaba;
Alternatif olsun.
İnceleyin.
İyi çalışmalar.
Link:
https://dosya.co/ntw2nwxc4q7r/Arkadasca-RECETE_CALISMA.rar.html

 

[Mukteda]

Merhaba;

.
Selamlar, Merhabalar,
Yardımınız için çok teşekkür ederim.
Ancak indiremiyorum.
Alternatif paylaşım sitesine yükleyebilir misiniz?

 

[veyselemre]

Dosyanız;
001 Kod Sayfası;

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$L$2" Then Exit Sub

    son = Cells(Rows.Count, 2).End(3).Row
    If Cells(son, 2) <> "İSTEĞİ YAPAN" Then son = son - 1
    If son > 45 Then
        fark = son - 45
        Rows("10:" & 10 + fark - 1).Delete
    End If
    Range("B4:I43").ClearContents

    malzeme = [L2]
    miktar = [L3]
    If malzeme <> "" Then
        strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & ThisWorkbook.FullName & _
                 "';Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"

        strsql = "SELECT F3, (" & miktar & "*F5), F4,null,null,null,null, F5 " & _
                 "FROM [VERI$A2:E" & Sheets("VERI").Cells(Rows.Count, 3).End(3).Row & "] " & _
                 "WHERE F1='" & malzeme & "'"

        Set rs = CreateObject("Adodb.RecordSet")
        rs.CursorLocation = 3
        rs.Open strsql, strCon
        fark = 0
        If rs.RecordCount > 40 Then
            fark = rs.RecordCount - 40 + 1
            Rows("10:" & 10 + fark - 1).Insert
        End If
        Range("B4").CopyFromRecordset rs
        rs.Close
        Cells(46 + fark, "E") = Date
    End If
End Sub

VERI Kod Sayfası;

Private Sub Worksheet_Deactivate()
    [AA:AA].ClearContents
    Range("Tablo1[[#All],[REÇETE KODU]]").AdvancedFilter Action:=xlFilterCopy, _
                                                         CopyToRange:=Range("AA1"), Unique:=True
    son = Cells(Rows.Count, "AA").End(3).Row
    ThisWorkbook.Names("Liste").RefersTo = "=VERI!" & Range("AA2:AA" & son).Address
    Range("AA1:AA" & son).NumberFormat = ";;;"
End Sub

 

[Mukteda]

Dosyanız;

.
Selamlar Veysel Bey İşlem tamamdır. Değerli çalışmanız için teşekkür ederim. Hakkınızı helal ediniz.

Sayın Muygun sizin de dosyanızı görmek isterdim. Müsait olduğunuzda harici paylaşım sitesine yüklerseniz sevinirim.

Kolay gelsin.

 

[muygun]

9 nolu mesaja harici link ekledim.

 

[Mukteda]

Teşekkür ederim.

 

[layla2518]

Merhaba;
Alternatif olsun.
İnceleyin.
İyi çalışmalar.
Link:
https://dosya.co/ntw2nwxc4q7r/Arkadasca-RECETE_CALISMA.rar.html

merhaba linki tekrar atmanız mümkün müdür ?