Hedef Kiloya Göre Etiket Hazırlama

[ywzyilmaz]

Merhaba Arkadaşlar

Şöyle bir kod da yardıma ihtiyacım var.
Mevcut hazırladığım kodda girilen kiloyu direkt etikete yazdırıyor.

Ben şunu yapmak istiyorum :

Benim standart kg 15 olacak. Kullanıcı 50 yazdıysa ilk etiket 15 kg ikinci etiket 15 kg üçüncü etiket 15 kg dördüncü etiket 5 kg.

Bu döngüyü nasıl kuracağımı bir türlü çözemedim.

Yardımcı olabilecek birisi var mı?

Sub mbetiket()
    Dim barkod As String
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Dim sonsat As Long, makno As String, baz As String, boyaadet As String, boyatur As String
    Dim makad As String, bazad As String, tarihad As String, barcevir As String
    Dim eat As Long, adlar As Long, mak As Long, bar As Long, bil As Long
    Dim y As Long
    
    Set s2 = ThisWorkbook.Sheets("etiketmb")
    Set s3 = ThisWorkbook.Sheets("rapor")
    Set s1 = ThisWorkbook.Sheets("veri")
    
    s2.Columns("A:G").ClearContents
    
    sonsat = s3.Range("A" & s3.Rows.Count).End(xlUp).Row
    makad = "Makina"
    bazad = "Masterbatch Adı"
    tarihad = "Üretim Tarihi"
    makno = s1.Range("B2").Value
    baz = s1.Range("H2").Value
    boyaadet = s1.Range("D2").Value
    boyatur = s1.Range("I2").Value
    barkod = s3.Range("A" & sonsat).Value
    barcevir = Code128(barkod)
    ilksat = 1
    boytur = 1
    bazlot = 5
    mak = 11
    zaman = 1
    bilgibar = 8
    For y = 1 To 1
        s2.Cells(ilksat, "A") = "MASTERBATCH TORBA ETIKETI"
        s2.Cells(boytur, "B") = "MIKTAR"
        s2.Cells(boytur, "C").Value = boyatur
        s2.Cells(zaman, "D") = "URETIM ZAMANI"
        s2.Cells(zaman, "E").Value = Now
        s2.Cells(bazlot, "C").Value = baz
        s2.Cells(bazlot, "B").Value = "MASTERBATCH ADI"
        s2.Cells(bilgibar, "D") = "BARKOD"
        s2.Cells(bilgibar, "E").Value = barcevir
        s2.Cells(bilgibar, "F").Value = barkod
        s2.Cells(mak, "B") = "MAKINA"
        s2.Cells(mak, "C").Value = makno
        s2.Cells(ilksat, "G") = "KISISEL KORUYUCU EKIPMAN"
    Next y
End Sub

 

[NBATMAN]

Merhaba,

aşağıdaki kodları kullanabilirsiniz.

Sub Toplam_KGye_Gore_Sabit_Degerden_Kac_Adet_ve_Kalan_Kg_icin_Etiket_Baski_Adeti_ve_bilgilerini_Hesaplama()

Dim Toplam_kg As Double
Dim Sabit_Kg As Double
Dim Kalan As Double
Dim Etikete_Yazılacak_Kgler() As Double
Dim i As Integer

Toplam_kg = 83
Sabit_Kg = 15

' bölüm sonucunda kalanı hesaplıyoruz
Kalan = Toplam_kg Mod Sabit_Kg

' Kalanı dikkate almadan sonuç sayısını hesaplayoruz
Dim Etiket_Sayısı As Integer
Etiket_Sayısı = Toplam_kg \ Sabit_Kg

' Sonuç sayısına göre sonuç dizisini yeniden boyutlandırma işlemini yapıyoruz
ReDim Etikete_Yazılacak_Kgler(1 To Etiket_Sayısı)

' Bölmeyi gerçekleştirip ve sonuçları dizide saklıyoruz
For i = 1 To Etiket_Sayısı
Etikete_Yazılacak_Kgler(i) = Sabit_Kg
Next i

' Kalan olup olmadığını kontrol edip ve onu dizinin son öğesine ekliyoruz
If Kalan > 0 Then
Etiket_Sayısı = Etiket_Sayısı + 1
ReDim Preserve Etikete_Yazılacak_Kgler(1 To Etiket_Sayısı)
Etikete_Yazılacak_Kgler(Etiket_Sayısı) = Kalan
End If

' Sonuçları A1, A2, A3, A4 hücrelerine (ve kalan varsa ek hücrelere) yazıyoruz
For i = 1 To Etiket_Sayısı
Range("A" & i).Value = Etikete_Yazılacak_Kgler(i)
Next i
End Sub