Satır Üretmek

[kaydina]

Arkadaşlar merhaba bir tablom var Stokadı ,Kalınlık,En,Boy diye yaklaşık 10 bin ad. stok var şimdi bu tabloya renk ekleyip her bir stok için 110 adet renkte stok eklemem lazım. Misal A isimli 20,15,30 öçüsünde 110 tane alta satır açıp yanlarına renkleri girmem gerekiyor. Bunun kısa yolu var mıdır?

 

[Korhan Ayhan]

Merhaba,

Bu işlemi SQL için mi istiyorsunuz?

Eğer excel tablosunda ise örnek dosyanızı paylaşım sitelerine yükleyip linkini forumda paylaşınız.

 

[kaydina]

Korhan bey merhaba Sql için istemiyorum sql aşamasını son noktada kullanacağım bundan sonra birkaç aşama daha var lazım olan excelde aynı listeyi her bir renk için tekrar oluşturması. Dosya gerekliyse örnek bir dosyada yükleyebilirim

 

[Korhan Ayhan]

Sorunuzu SQL bölümüne sormuşsunuz. Ben makrolar bölümüne taşıdım.

Lütfen örnek dosyanızı ekleyin.

Dosyanızda ham verim bu şekilde, ben şu şekilde olmasını istiyorum diyerek örnekleyiniz.

 

[kaydina]

Dosyayı yükledim. Adresi https://yadi.sk/d/s_B0ZMw83Lf2yg

Dosyayı açınca Colour ve Stock adlı 2 çalışma sayfası gözükecek istediğim şey Stock çalışma sayfasında ki her bir stoğun her bir colour için bir adet oluşturulması. Yaklaşık 477 stock kalemi var ve 111 renk kodu var bu işlem sonucunda 52947 stock oluşacak gibi bir ihtimal düşünelim. İşlemi yaparken 1 satırı alıp colour hanesine colour adını veya kodunu yazacak 111 colour olduğu için ilk satır 110 tane artacak

 

[Korhan Ayhan]

Deneyiniz.

Kodun sonucunda YENİ bir sayfa oluşur ve istediğiniz liste bu sayfada listelenir.

Option Explicit

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Satir As Long, Son As Long, Renk_Say As Integer, X As Long
    
    Set S1 = Sheets("Colour")
    Set S2 = Sheets("Stock")
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Yeni_Liste").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    Set S3 = Sheets.Add
    S3.Name = "Yeni_Liste"
    
    S2.Range("A4:U4").Copy S3.Range("A4")
    Satir = 5
    Son = S2.Cells(S2.Rows.Count, 4).End(3).Row
    Renk_Say = S1.Cells(S1.Rows.Count, 2).End(3).Row - 1
    
    For X = 5 To Son
        S3.Range("A" & Satir & ":U" & Satir + Renk_Say - 1).Value = S2.Range("A" & X & ":U" & X).Value
        S3.Range("K" & Satir & ":K" & Satir + Renk_Say - 1).Value = S1.Range("B2:B" & Renk_Say + 1).Value
        S3.Range("L" & Satir & ":L" & Satir + Renk_Say - 1).Value = S1.Range("C2:C" & Renk_Say + 1).Value
        S3.Range("M" & Satir & ":M" & Satir + Renk_Say - 1).Value = S1.Range("A2:A" & Renk_Say + 1).Value
        Satir = S3.Cells(S3.Rows.Count, 4).End(3).Row + 1
    Next

    S3.Cells.EntireColumn.AutoFit
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kaydina]

Yeminle süpersiniz , çok ama çok teşekkür ederim. İşimi kolaylaştırdınız Allah da sizin işlerinizi kolaylaştırsın.

 

[kaydina]

Not: Yazdığınız kodu anlamaya çalışırken sorunu bulup çözdüm denediğim örneklerde boş satırlardan dolayı olmamış..Tekrardan teşekkür ederim


Üstadım şöyle bir durum farkettim sadece ilk satır için işlemi yapıyor gibi yüklediğim dosyaya bir bakabilir misiniz https://yadi.sk/i/q3qrpt_13Lh6t9

 

[Korhan Ayhan]

Kodun sağlıklı çalışması için "Stock" isimli sayfanızda "D" sütununun dolu olması gerekiyor.

Son eklediğiniz dosyaya göre kodu aşağıdaki gibi değiştirip deneyiniz.

Option Explicit

Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Satir As Long, Son As Long, Renk_Say As Integer, X As Long
    
    Set S1 = Sheets("Colour")
    Set S2 = Sheets("Stock")
    
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Yeni_Liste").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    Set S3 = Sheets.Add
    S3.Name = "Yeni_Liste"
    
    S2.Range("A4:U4").Copy S3.Range("A4")
    Satir = 5
    Son = S2.Cells(S2.Rows.Count, 6).End(3).Row
    Renk_Say = S1.Cells(S1.Rows.Count, 2).End(3).Row - 1
    
    For X = 5 To Son
        S3.Range("A" & Satir & ":U" & Satir + Renk_Say - 1).Value = S2.Range("A" & X & ":U" & X).Value
        S3.Range("K" & Satir & ":K" & Satir + Renk_Say - 1).Value = S1.Range("B2:B" & Renk_Say + 1).Value
        S3.Range("L" & Satir & ":L" & Satir + Renk_Say - 1).Value = S1.Range("C2:C" & Renk_Say + 1).Value
        S3.Range("M" & Satir & ":M" & Satir + Renk_Say - 1).Value = S1.Range("A2:A" & Renk_Say + 1).Value
        Satir = S3.Cells(S3.Rows.Count, 6).End(3).Row + 1
    Next

    S3.Cells.EntireColumn.AutoFit
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub