Veriyi yığınını dikey olarak çoklama

polyester · 9 Ocak 2014

soruma ait örnek linkte bulunuyor. Kısaca anlatmam gerekirse bir artikele ait bileşen listesini o artikele ait numaralar adetince alt alta kopyalamam gerekiyor. Bunu yapan bir formül var elimde fakat satır sayısı yetersiz olduğu için ve bilgisayarı kilitlediği için bir makronun daha iyi olacağı düşüncesindeyim. Sonuç olarak istediğim veri 700.000-800.000 satırı belki 1.000.000 satırı bulacaktır.
Linkte bulunan örnek 4 sekmeden oluşuyor. yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

https://drive.google.com/file/d/0B7wdNU06a5CbNUR3MTQ0OFVidDQ/edit?usp=sharing

systran · 9 Ocak 2014

örneğiniz pek anlaşılır değil (en azından benim için) biraz daha ayrıntılı yazar mısınız? diğer sayfalar
"bileşen, matnr, ölçü birimi"; "istenen" sayfasındaki veriyi elde etmek için kullanılacak mı?

polyester · 9 Ocak 2014

systran' Alıntı:
örneğiniz pek anlaşılır değil (en azından benim için) biraz daha ayrıntılı yazar mısınız? diğer sayfalar
"bileşen, matnr, ölçü birimi"; "istenen" sayfasındaki veriyi elde etmek için kullanılacak mı?

dediğiniz gibi bileşen, matnr, ölçü birimi sayfasında ki verileri girerek istenen sekmesinde bulunan veriyi elde etmek istiyorum.

Örnek olarak;

A artikeline ait 5 bileşen, birim vs bulunuyor ve A artikeline ait 10 matnr numarası bulunuyor. Bu 5 bileşeni 10 matnr numarasının herbiri için alt alta çoklansın istiyorum. yani toplamda 5*10= 50 satırlık bir verinin olması gerekiyor.

umarım daha anlaşılır olmuştur. Teşekkür ederim

Korhan Ayhan · 10 Ocak 2014

Aşağıdaki kodu deneyiniz.

Kod:

Sub Listele()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim Say As Integer, Satir As Long, X As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("bileşen")
    Set S2 = Sheets("matnr")
    Set S3 = Sheets("ölçü birimi")
    Set S4 = Sheets("istenen")
    S4.Range("A3:J" & Rows.Count).ClearContents
    
    Say = S1.Cells(Rows.Count, 1).End(3).Row - 2
    Satir = 3
    
    For X = 2 To S2.Cells(Rows.Count, 2).End(3).Row
        If S2.Cells(X, 2) <> "" Then
            S4.Cells(Satir, 1).Resize(Say) = S2.Cells(X, 2)
            S4.Cells(Satir, 2).Resize(Say) = 1000
            S4.Cells(Satir, 3).Resize(Say) = 1
            S1.Range("B3:G" & Say + 2).Copy S4.Cells(Satir, 5)
            S4.Cells(Satir, 4) = 10
            S4.Cells(Satir + 1, 4) = 20
            S4.Range("D" & Satir & ":D" & Satir + 1).AutoFill _
            Destination:=S4.Range("D" & Satir & ":D" & Satir + Say - 1), Type:=xlFillDefault
            Satir = S4.Cells(Rows.Count, 1).End(3).Row + 1
        End If
    Next

    S4.Range("A3:J" & Rows.Count).Sort Key1:=S4.Range("A3"), Order1:=xlAscending, _
    Key2:=S4.Range("D3"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
    
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

polyester · 10 Ocak 2014

Korhan Ayhan' Alıntı:

Aşağıdaki kodu deneyiniz.

Kod:

Sub Listele()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim Say As Integer, Satir As Long, X As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("bileşen")
    Set S2 = Sheets("matnr")
    Set S3 = Sheets("ölçü birimi")
    Set S4 = Sheets("istenen")
    S4.Range("A3:J" & Rows.Count).ClearContents
    
    Say = S1.Cells(Rows.Count, 1).End(3).Row - 2
    Satir = 3
    
    For X = 2 To S2.Cells(Rows.Count, 2).End(3).Row
        If S2.Cells(X, 2) <> "" Then
            S4.Cells(Satir, 1).Resize(Say) = S2.Cells(X, 2)
            S4.Cells(Satir, 2).Resize(Say) = 1000
            S4.Cells(Satir, 3).Resize(Say) = 1
            S1.Range("B3:G" & Say + 2).Copy S4.Cells(Satir, 5)
            S4.Cells(Satir, 4) = 10
            S4.Cells(Satir + 1, 4) = 20
            S4.Range("D" & Satir & ":D" & Satir + 1).AutoFill _
            Destination:=S4.Range("D" & Satir & ":D" & Satir + Say - 1), Type:=xlFillDefault
            Satir = S4.Cells(Rows.Count, 1).End(3).Row + 1
        End If
    Next

    S4.Range("A3:J" & Rows.Count).Sort Key1:=S4.Range("A3"), Order1:=xlAscending, _
    Key2:=S4.Range("D3"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
    
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

öncelikle ilgilenip yardımcı olduğunuz için teşekkür ederim. Verdiğiniz kodu test ettim:
* O "MATNR" numarasına dolayısıyla o artikele ait olmayan bileşen satırları istenen sekmesin de listeleniyor. (linkte bulunan dosya incelendiğinde daha net görülecektir)

https://drive.google.com/file/d/0B7wdNU06a5CbZkFOTHJxaUhBQVE/edit?usp=sharing

Korhan Ayhan · 10 Ocak 2014

Merhaba,

Vermiş olduğunuz linkteki dosyayı inceledim. Fakat ne demek istediğinizi çok net anlayamadım.

Makro şu işlemi yapıyor;

"MATNR" sayfasındaki "B" sütunundaki verileri döngüye alıyor.
"BİLEŞEN" sayfasında bulunan 31 satırlık tabloyu kopyalayıp "İSTENEN" sayfasındaki ilk boş satıra yapıştırıyor.
Sonra sizin istediğiniz detayları ilgili sütunlara yazıyor. ( Üretim yeri- Alternatif ÜA- Kalem numarası)

"MATNR" sayfasının "A" sütunundaki artikel numaralarını "BİLEŞEN" sayfasının "A" sütununda saydırdığımda sonuç hep 31 adet çıkıyor.

Eğer sizin orjinal verinizde durum farklı ise belirtmenizde fayda var. Ya da ben yapmak istediğiniz işlemi yanlış anlamış olabilirim.

polyester · 10 Ocak 2014

Korhan Ayhan' Alıntı:
Merhaba,

Vermiş olduğunuz linkteki dosyayı inceledim. Fakat ne demek istediğinizi çok net anlayamadım.

Makro şu işlemi yapıyor;

"MATNR" sayfasındaki "B" sütunundaki verileri döngüye alıyor.
"BİLEŞEN" sayfasında bulunan 31 satırlık tabloyu kopyalayıp "İSTENEN" sayfasındaki ilk boş satıra yapıştırıyor.
Sonra sizin istediğiniz detayları ilgili sütunlara yazıyor. ( Üretim yeri- Alternatif ÜA- Kalem numarası)

"MATNR" sayfasının "A" sütunundaki artikel numaralarını "BİLEŞEN" sayfasının "A" sütununda saydırdığımda sonuç hep 31 adet çıkıyor.

Eğer sizin orjinal verinizde durum farklı ise belirtmenizde fayda var. Ya da ben yapmak istediğiniz işlemi yanlış anlamış olabilirim.

Merhaba,

şu şekilde olması gerekiyor:

istenen sayfasındaki verileri "MATNR" ve "BİLEŞEN" sayfasındaki verileri karşılaştırarak yapıştırması lazım.
Mesela; "BİLEŞEN" sekmesinde ki "I30G04060400" süzdüğümüzde dediğiniz gibi 31 adet satır karşımıza çıkıyor
MATNR sekmesinde yine"I30G04060400" artikeli için 22 adet numara karşımıza çıkıyor.
Yani toplamda 31*22=682 ad satır istenen sekmesinde sadece bu seçtiğimiz artikel için gelmeli
Aynı şekilde "I30y15464001" artikeli için bileşen sayfasında 31, satır matnr sayfasında ise 28 malzeme numarası var.
Toplamda 31*28=868 satır "I30y15464001" artikeli için istenen sekmesinde listelenmeli
"IW2I16120200" artikeli için bileşen sayfasında 39 satır var, matnr sayfasında ise 33 numara bulunuyor
Toplamda 39*33= 1287 satır IW2I16120200 artikeli için istenen sekmesinde listelenmeli
En son toplam olarak 682+868+1287= 2837 satır istenen sayfasında listelenmelidir.

Özet olarak yapmak istediğim şey düşeyara mantığına benziyor. Bileşen ve matnr sayfasında ortak bulunan artikel bilgisini karşılaştırıp
daha sonra istenen sayfasında çoklanıp listelenmesini istiyorum. Teşekkür ederim

Korhan Ayhan · 10 Ocak 2014

Bileşen sayfasındaki artikel noları karışık şekilde mi? Yoksa sıralı olarak mı devam ediyor?

polyester · 10 Ocak 2014

Korhan Ayhan' Alıntı:
Bileşen sayfasındaki artikel noları karışık şekilde mi? Yoksa sıralı olarak mı devam ediyor?

bileşen sayfasındaki artikeller sıralı şekilde devam ediyor.

Korhan Ayhan · 10 Ocak 2014

Boşa kürek çekmemek için anladığım kurguyu ifade ediyorum;

"MATNR" isimli sayfanızın "A" sütunundaki artikel nolarını benzersiz bir şekilde başka bir alana aktaracak.
Sonra bu numaraları döngüye alacak.

Eklediğiniz dosya için örneklersek;

"I30Y15464210" nolu artikelden "MATNR" sayfanızda 28 satır var.
Aynı artikelden "BİLEŞEN" sayfanızda ise 31 satır var.

"MATNR" sayfanızdaki 28 satır için "B" sütunundaki ilk veri "40032536003" nolu veridir. Bu numara için 31 satırlık datayı istenen sayfasına aktaracak.

28 satırlık bloğun "B" sütunundaki numaraların tümü için bu işlemi yapacak.

Eğer yanlış anladığım nokta varsa düzeltir misiniz?

polyester · 10 Ocak 2014

Korhan Ayhan' Alıntı:
Boşa kürek çekmemek için anladığım kurguyu ifade ediyorum;

"MATNR" isimli sayfanızın "A" sütunundaki artikel nolarını benzersiz bir şekilde başka bir alana aktaracak.
Sonra bu numaraları döngüye alacak.

Eklediğiniz dosya için örneklersek;

"I30Y15464210" nolu artikelden "MATNR" sayfanızda 28 satır var.
Aynı artikelden "BİLEŞEN" sayfanızda ise 31 satır var.

"MATNR" sayfanızdaki 28 satır için "B" sütunundaki ilk veri "40032536003" nolu veridir. Bu numara için 31 satırlık datayı istenen sayfasına aktaracak.

28 satırlık bloğun "B" sütunundaki numaraların tümü için bu işlemi yapacak.

Eğer yanlış anladığım nokta varsa düzeltir misiniz?

evet dediğiniz gibi olacaktır.
Böylece "I30Y15464210" artikeli için toplamda 28*31= 868 satırlık bir veri oluşmuş olacaktır. Bu işlem diğer artikeller içinde bu şekilde alt alta eklenerek devam edecektir

Korhan Ayhan · 10 Ocak 2014

Bir şey daha sormak istiyorum.

"MTNR" sayfasındaki "A" sütunundaki artikel numaraları da sıralı mıdır?

polyester · 10 Ocak 2014

Korhan Ayhan' Alıntı:
Bir şey daha sormak istiyorum.

"MTNR" sayfasındaki "A" sütunundaki artikel numaraları da sıralı mıdır?

Evet. MATNR ve BİLEŞEN sayfasında ki artikel isimleri alfabetik sıraya göredir.

Yapacağım işlemin büyüklüğüne bakarsak 500.000-600.000 satırlık bir veri listelenecektir

Korhan Ayhan · 10 Ocak 2014

Aşağıdaki kodu deneyiniz.

Kod:

Sub Listele()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim SayA As Integer, SayB As Integer
    Dim Satir As Long, X As Long, Y As Long
    Dim IlkA As Long, SonA As Long
    Dim IlkB As Long, SonB As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("bileşen")
    Set S2 = Sheets("matnr")
    Set S3 = Sheets("ölçü birimi")
    Set S4 = Sheets("istenen")
    
    On Error Resume Next
    If S4.AutoFilterMode Then S4.ShowAllData
    On Error GoTo 0
    
    S4.Range("A3:J" & Rows.Count).ClearContents
    
    Satir = 3
        
    S2.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("D1"), Unique:=True

    For X = 2 To S2.Cells(Rows.Count, 4).End(3).Row
        If S2.Cells(X, 4) <> "" Then
            SayA = WorksheetFunction.CountIf(S2.Range("A:A"), S2.Cells(X, 4))
            SayB = WorksheetFunction.CountIf(S1.Range("A:A"), S2.Cells(X, 4))
            IlkA = S2.Range("A:A").Find(S2.Cells(X, 4)).Row
            SonA = IlkA + SayA - 1
            IlkB = S1.Range("A:A").Find(S2.Cells(X, 4)).Row
            SonB = IlkB + SayB - 1
            
            For Y = IlkA To SonA
                S4.Cells(Satir, 1).Resize(SayB) = S2.Cells(Y, 2)
                S4.Cells(Satir, 2).Resize(SayB) = 1000
                S4.Cells(Satir, 3).Resize(SayB) = 1
                S1.Range("B" & IlkB & ":G" & SonB).Copy S4.Cells(Satir, 5)
                S4.Cells(Satir, 4) = 10
                S4.Cells(Satir + 1, 4) = 20
                S4.Range("D" & Satir & ":D" & Satir + 1).AutoFill _
                Destination:=S4.Range("D" & Satir & ":D" & Satir + SayB - 1), Type:=xlFillDefault
                With S4.Range("H" & Satir & ":H" & Satir + SayB - 1)
                    .Formula = "=IF(ISNA(VLOOKUP(F" & Satir & ",'" & S3.Name & "'!A:B,2,0)),"""",VLOOKUP(F" & Satir & ",'" & S3.Name & "'!A:B,2,0))"
                    .Value = .Value
                End With
                Satir = S4.Cells(Rows.Count, 1).End(3).Row + 1
            Next
        End If
    Next

    S4.Range("A3:J" & Rows.Count).Sort Key1:=S4.Range("A3"), Order1:=xlAscending, _
    Key2:=S4.Range("D3"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal

    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
    
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

polyester · 11 Ocak 2014

Korhan hocam çok teşekkür ederim. Makro istediğim gibi çalışıyor.
son olarak birşey rica edeceğim: "ÖLÇÜ BİRİMİ" sayfasında bilşen ve ölçü birimi bulunuyor. burda bulunan ölçü birimini "istenen" sayfasında bileşen yanına makro ile getirebilir miyiz? (Düşeyara gibi)

Korhan Ayhan · 11 Ocak 2014

Üstteki mesajımda ki kodu güncelledim. Deneyiniz.

İşlem ne kadar sürüyor?

polyester · 11 Ocak 2014

Korhan Ayhan' Alıntı:
Üstteki mesajımda ki kodu güncelledim. Deneyiniz.

İşlem ne kadar sürüyor?

707.000 satırlık verinin listelenmesi 8 dakika sürdü. Bu süre benim için makuldur. Yalnız ölçü birimi sayfasında yer almayan bileşen kodlarının karşılığında da istenen sayfasında "m,kg,adt" gibi değerler geliyor. eğer ölçü birimi sayfasında bileşen kodunun karşılığı yer almıyorsa istenen sayfasında karşılığının boş olmasını sağlayabilir miyiz?

Korhan Ayhan · 11 Ocak 2014

14 nolu mesajımda ki kodu güncelledim. Deneyiniz.

polyester · 11 Ocak 2014

sorun devam ediyor. boş gelmesi gereken "ölçü birimi" hücreleri "kg, adt, m" olarak listeleniyor. sonuçlanma süresi de 18 dakika ya çıktı

Korhan Ayhan · 11 Ocak 2014

Ben eklemiş olduğunuz örnek dosyada denediğimde olumlu sonuç alıyorum.

BİLEŞEN sayfasındaki numaraları değiştirdim. Makroyu çalıştırdım. Bulamadığı numaraların karşısını boş bırakıyor.

HESAPLAMA ayarlarınız manuele ayarlı olabilir. Kontrol edip tekrar deneyin.

Yine sonuç alamazsanız uygulama yaptığınız dosyanızın küçük bir örneğini gönderin kontrol edelim.

Veriyi yığınını dikey olarak çoklama

polyester

systran

Destek Ekibi

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator

polyester

Korhan Ayhan

Administrator