Makro ile etiket doldurma

[samuelsaw]

Gerekli açıklamaları ekte yaptım yardımcı olan arkadaşlara teşekkür ederim...

 

[accountant80]

Merhaba Makro yerine eşitleme ile olur mu ? c2,c3,c4 hücrelerine yazdıklarınızı tümüne yazar, İnceleyiniz

 

[samuelsaw]

Merhaba Makro yerine eşitleme ile olur mu ? c2,c3,c4 hücrelerine yazdıklarınızı tümüne yazar, İnceleyiniz

ilginiz için teşekkkür ederim...
amaç hep aynı değerlerle çalışmak olsaydı dediğiniz olabilir di ama benim değerlerimin hepsi farklı kod renk fiyat hepsi farklı....bu nedenle eşitleme olmaz...

 

[accountant80]

Farklı derken, belirli bir sıra ile mi gidecek? Renkler hangi sıra ile olacak?TL tutarı ne olacak?
sorunuzda bunları belirtmemişsiniz.

 

[samuelsaw]

Farklı derken, belirli bir sıra ile mi gidecek? Renkler hangi sıra ile olacak?TL tutarı ne olacak?
sorunuzda bunları belirtmemişsiniz.

2462 SYH-GRİ 134,6835234 bu sıra c2 c3 c4
2490 SYH 134,6835234 c5 c6 c7
4206 SYH-SYH SÜET 134,6835234 c8 c9 c10
4215 SYH SÜET-SYH 134,6835234
4217 SYH 134,6835234
4233 SYH-SYH NBK 134,6835234
4267 FÜME-SYH NBK 134,6835234
4267 LACİ-TABA NBK 134,6835234
4267 VZN-VZN NBK 134,6835234
4267 SYH-SYH NBK 134,6835234
bu şekilde gidecek..

 

[accountant80]

2462 SYH-GRİ 134,6835234 bu sıra c2 c3 c4
2490 SYH 134,6835234 c5 c6 c7
4206 SYH-SYH SÜET 134,6835234 c8 c9 c10
4215 SYH SÜET-SYH 134,6835234
4217 SYH 134,6835234
4233 SYH-SYH NBK 134,6835234
4267 FÜME-SYH NBK 134,6835234
4267 LACİ-TABA NBK 134,6835234
4267 VZN-VZN NBK 134,6835234
4267 SYH-SYH NBK 134,6835234
bu şekilde gidecek..

Özür dilerim anlayamadım, anlayan arkadaşlar yardımcı olacaktır.

 

[samuelsaw]

Özür dilerim anlayamadım, anlayan arkadaşlar yardımcı olacaktır.

rica ederim ben anlatamadım..tekrar açıklamalarla dosyayı ekledim..teşekkür ederim...

 

[Necdet]

Merhaba,

Tüm etiketler dolduktan sonra ne olacağı belirsiz ama kodları inceleyiniz.

Sub Doldur()
    
    Dim i   As Long, _
        j   As Integer, _
        Kol As Integer
    
    Application.ScreenUpdating = False
    
    j = 2
    Kol = 3
    Range("C2:C22,E2:E22,G2:G22,J2:J22,L2:L22,N2:N22").ClearContents
    
    For i = 2 To Cells(Rows.Count, "P").End(3).Row
    
        Cells(j, Kol) = Cells(i, "P")
        Cells(j + 1, Kol) = Cells(i, "Q")
        Cells(j + 2, Kol) = Cells(i, "R")
        
        j = j + 3
        If j > 20 Then
            j = 2
            Kol = Kol + 2
            If Kol = 9 Then Kol = Kol + 1
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Doldurdum...."
    
End Sub

 

[samuelsaw]

Merhaba,

Tüm etiketler dolduktan sonra ne olacağı belirsiz ama kodları inceleyiniz.

Sub Doldur()
    
    Dim i   As Long, _
        j   As Integer, _
        Kol As Integer
    
    Application.ScreenUpdating = False
    
    j = 2
    Kol = 3
    Range("C2:C22,E2:E22,G2:G22,J2:J22,L2:L22,N2:N22").ClearContents
    
    For i = 2 To Cells(Rows.Count, "P").End(3).Row
    
        Cells(j, Kol) = Cells(i, "P")
        Cells(j + 1, Kol) = Cells(i, "Q")
        Cells(j + 2, Kol) = Cells(i, "R")
        
        j = j + 3
        If j > 20 Then
            j = 2
            Kol = Kol + 2
            If Kol = 9 Then Kol = Kol + 1
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Doldurdum...."
    
End Sub

NECDET HOCAM, çok teşekkür ederim...
tek bir yerde sorunum var onu ekte açıkladım.....tekrar teşekkür ederim...

 

[Necdet]

Merhaba,

Sanırım siz etiketlerin doldurulmasına devam etmesini istiyorsunuz. Zaten soru eksik derken bunu demek istemiştim.

Sub Doldur()
    
    Dim i   As Long, _
        Sat As Long, _
        j   As Integer, _
        Kol As Integer, _
        Grp As Integer
    
    Application.ScreenUpdating = False
    
    Grp = 1
    Sat = 2
    j = 0
    Kol = 3
    Range("C:C,E:E,G:G,J:J,L:L,N:N").ClearContents
    
    For i = 2 To Cells(Rows.Count, "P").End(3).Row
    
        Cells(Sat, Kol) = Cells(i, "P")
        Cells(Sat + 1, Kol) = Cells(i, "Q")
        Cells(Sat + 2, Kol) = Cells(i, "R")
        
        Sat = Sat + 3
        j = j + 1
        If j > 6 Then
            j = 0
            Sat = (Grp - 1) * 22 + 2
            Kol = Kol + 2
            If Kol = 9 Then Kol = Kol + 1
            If Kol > 14 Then
                Kol = 3
                Grp = Grp + 1
                Sat = (Grp - 1) * 22 + 2
            End If
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Doldurdum...."
    
End Sub

 

[samuelsaw]

teşekkür ederim hocam...tam istediğim gibi...ii çalışmalar size...