Tanımlı Değer Kadar Etiket Basma Yardım!!!

baykan_m

Altın Üye
Katılım
26 Ağustos 2015
Mesajlar
257
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
22.03.2028
Merhaba Arkadaşlar,

Ben yazdığım listenin tamamını etiket olarak basacağım. Bazı etiketleri dosyada yer alan "Paket Sayısı" sütununa yazılmış olan değer kadar sayfa2 ye yazdırmak istiyorum. Yani A2 satırında yer alan değerleri "Paket Sayısı" sütununda 3 yazdığı için 3 kez sayfa2 de yer alan formata göre yazdırmak istiyorum. Dosya içerisinde de açıklamaya çalıştım umarım anlaşılmıştır. Çok uğraştım ancak başaramadım. Yardımcı olanlara şimdiden teşekkür ederim.
 

Ekli dosyalar

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.
Belge ekte.
 

Ekli dosyalar

baykan_m

Altın Üye
Katılım
26 Ağustos 2015
Mesajlar
257
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
22.03.2028
Çok teşekkürler güzel olmuş Ömer Bey ellerinize sağlık.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Kolay gelsin.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,438
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Makrolu seçenek olsun.

Kodları bir modüle kopyalayıp deneyiniz.
Kod:
Sub EtiketHazırla()

    Dim s1  As Worksheet, _
        s2  As Worksheet, _
        i   As Long, _
        j   As Long, _
        k   As Integer, _
        s   As Integer, _
        t   As String
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    s2.Columns("A:B").ClearContents

    j = 1
    
    For i = 2 To s1.Cells(Rows.Count, "A").End(3).Row
    
        t = s1.Cells(i, "A") & Chr(10) & _
            s1.Cells(i, "B") & Chr(10) & _
            s1.Cells(i, "C") & Chr(10) & _
            s1.Cells(i, "D") & Chr(10) & _
            s1.Cells(i, "E") & Chr(10) & _
            s1.Cells(i, "F") & Chr(10) & _
            s1.Cells(i, "G")
        
        For k = 1 To s1.Cells(i, "G")
            s = s + 1
            If s > 2 Then
                j = j + 1
                s = 1
            End If
            s2.Cells(j, s) = t
        Next k
        
    Next i
    
    Application.ScreenUpdating = True
    
End Sub
 

baykan_m

Altın Üye
Katılım
26 Ağustos 2015
Mesajlar
257
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
22.03.2028
Necdet Bey çok teşekkür ederim buda çok güzel olmuş. Ancak bunda paket sayısı (G sütunu) 1 olanı hiç yazdırmamış, paket sayısı 1 ise 1 kez etiket yazması gerekiyor. Bunun için kodda nasıl bir değişiklik yapmam gerekiyor acaba?
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,438
Excel Vers. ve Dili
Ofis 365 Türkçe
G sütununu zaten kontrol ediyor. Denedim doğru çalışıyor, siz nerede takıldınız?
 

baykan_m

Altın Üye
Katılım
26 Ağustos 2015
Mesajlar
257
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
22.03.2028
G sütununda en sonda yer alan MEŞE 5549 ürünün paket sayısı 1. Ancak sayfa 2 de bu ürünü yazmamış bunun dışında hepsi doğru Necdet Bey.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,438
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

G sütununda 1 gibi görünen değer 0,5. Dolayısıyla döngü oluşmuyor. Formülünüzü düzeltmeniz halinde çalışacaktır.

Kod:
=EĞER(H2<2;1;H2/2)
Formülünüzü bu şekilde oluşturun.
 

baykan_m

Altın Üye
Katılım
26 Ağustos 2015
Mesajlar
257
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
22.03.2028
Normalde Paket Sayısı, Adet sayısının yarısı kadar olması gerekiyor ancak bazı durumlarda 1 adet iade olduğuda oluyor ondan dolayı o şekilde formül yazdım 1 görünsün diye. Kodların 1den düşük olanı 1 görmesi için ne yapmam gerekiyor peki?
 

baykan_m

Altın Üye
Katılım
26 Ağustos 2015
Mesajlar
257
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
22.03.2028
Çok pardon formülü görmemişim şimdi denedim oldu çok teşekkürler emeğinize sağlık.
 
Üst