Stıker programı

[xxSİYaHxx]

Merhaba,
Arkadaşlar sizden ricamı eklemiş olduğum örnekte belirttim ama tekrardan anlatayım. Aylık ortalama olarak 1500 - 2000 arası müşteriye CD çıkışı oluyor. Bunların STIKER'lerini yazmak ölüm geliyor. Sayın üstadlardan istediğim veri sayfasını ben doldurduktan sonra otomatik olarak STIKER sayfasına oradaki belirtmiş olduğum formatta atmasını rica ediyorum

 

[xxSİYaHxx]

Yardım eden olmayacak mı???

 

[Ömer]

Merhaba,

STIKER sayfası A2 hücresine yazarak yana ve alt satırlara kopyalayın.

=KAYDIR(Veri!$A$2;SATIR(A1)*5-6+SÜTUN(A1);0)&DAMGA(10)&KAYDIR(Veri!$B$2;SATIR(A1)*5-6+SÜTUN(A1);0)&DAMGA(10)&KAYDIR(Veri!$C$2;SATIR(A1)*5-6+SÜTUN(A1);0)&DAMGA(10)&EĞER(KAYDIR(Veri!$D$2;SATIR(A1)*5-6+SÜTUN(A1);0)=0;"";"CD-"&KAYDIR(Veri!$D$2;SATIR(A1)*5-6+SÜTUN(A1);0))

.

 

[xxSİYaHxx]

Teşekkür ederim olmuş ama ben CD Adeti yazdığım yere 2 yada daha fazla bir rakam yazdığımda üst sırası aynı kalacak şekilde CD-1 CD-2 olarak ayrı ayrı stıker çıkartması gerekiyor. Örneğin x müşterisinin 3 cd'si çıktığını var sayarsak. Her Stıker kutusuna x CD-1 x CD-2 x CD-3 yazması gerekiyordu. Şuan neyi görüyorsa onu alıyor

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz.

Option Explicit
Sub EtiketeAktar()
Dim shv     As Worksheet
Dim shs     As Worksheet
Dim i       As Long
Dim j       As Long
Dim Kol     As Long
Dim Adet    As Integer
Dim k       As Integer
Set shv = Sheets("Veri")
Set shs = Sheets("STIKER")
shs.Select
j = 2
Application.ScreenUpdating = True
Range("A:E").ClearContents
For i = 2 To shv.[A65536].End(3).Row
    If shv.Cells(i, "D") = "" Then
        Adet = 1
    Else
        Adet = shv.Cells(i, "D")
    End If
    
    For k = 1 To Adet
        Kol = Kol + 1
        If Kol > 5 Then
            Kol = 1
            j = j + 1
            If j Mod 15 = 0 Then j = j + 2
        End If
        
        shs.Cells(j, Kol) = shv.Cells(i, "A") & Chr(10) & shv.Cells(i, "B") & Chr(10) & shv.Cells(i, "C")
        If shv.Cells(i, "D") <> "" Then shs.Cells(j, Kol) = shs.Cells(j, Kol) & Chr(10) & "CD - " & k
    Next k
Next i
Application.ScreenUpdating = True
Set shv = Nothing
Set shs = Nothing
End Sub

 

[xxSİYaHxx]

Selam

Arkadaşlar, istediğim programı biraz kolaylaştırdım. Bunun formullemesi daha kolay olacağını düşünüyorum. Talebim ekte. Şimdiden ilgilenen tüm arkadaşlara teşekkürler.

 

[Ömer]

Son eklediğiniz tabloya göre formüllede olabilir. Fakat Necdet bey tam olması gereken gibi makroyu yazmış. Kodları kullanmanız daha mantıklı olacaktır.

.

 

[xxSİYaHxx]

Telekkür ederim. Ömer bey ama makro'dan hiç anlamıyorum. Gene formullerden az çok anlıyorum. Daha makro'da neyi nereye yapıştıracağımı bilmiyorum. Yarın bir sorun çıktığında kalırım. O yüzden düz mantık daha iyi olacağını düşündüm.

Ayrıca makro'da da açtığımda sürekli bana ekte belirttiğim hatayı veriyor.

 

[Ömer]

Önce bir makroyu dosyanızda deneyin derim. Olmazsa yine formülü yazarız.

Aşağıdaki işlemleri sırası ile uygulayınız.

Boş bir excel çalışması açın menü çubuğundan Araçlar / Makro / Güvenlik menüsünden Düşük(önerilmezi) işaretleyerek tamam butonuna basın daha sonra bu dosyayı kapatın. ( kaydetmenize gerek yoktur). Bu işlemi kullandığınız bilgisayarda bir kere yapmanız yeterli olacaktır.

Resimli anlatım için,

Makroları etkin kılmak.Güvenlik düzeyini düşürmek

Buda modul eklemeyle ilgili resimli anlatım.

Modül Ekleme (Resimli Anlatım)

Ayrıca Necdet bey'in dosyasında bu yapılanıda görebilirsiniz.

.

 

[xxSİYaHxx]

Necdet ve Ömer Bey ikinizede ayrı ayrı teşekkürlerimi sunuyorum. Çok güzel bir çalışma oldu.