Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Satır Üretmek (http://www.excel.web.tr/showthread.php?t=165851)

kaydina 02-08-2017 08:14

Satır Üretmek
 
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 02-08-2017 08:57

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 02-08-2017 11:17

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 02-08-2017 11:40

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 02-08-2017 17:39

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 03-08-2017 02:34

Deneyiniz.

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

Kod:

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 03-08-2017 20:23

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 03-08-2017 20:59

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 04-08-2017 00:21

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.

Kod:

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



Saat 17:06

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.