Soru Verilerin Düzenlenmesi Hakkında

[kutluaye]

Merhabalar;

Verilerin düzenlenmesiyle ilgili olarak yardımınıza ihtiyacım var ilk kısmı (tomruk numarası) forumdaki konulardan yararlanarak çözdüm ancak devamında yapılması gereken dağılım için gerekli algoritmayı oluşturamam açıklayıcı olması adına renklendirme yaptım. yardımınız için şimdiden teşekkürler

 

[recepkull]

Ne yapmak istediğinizi yazmamışsınız !

 

[kutluaye]

0001 aynı tomruk numarasına ait 3 farklı ölçüde ki 13 keresteyi alt alta sıralama gerekiyor ve aynı zaman da hepsi aynı tomruk numarasını almalı

 

[kutluaye]

tam anlamı ile anlaşılması adına tekrar açıkladım yardımlarınızı bekliyorum teşekkürler

hücrelerde olmasını istediğim sıralama ve hangi hücreden değerlerin gelmesi gerektiğini yazdım

 

[recepkull]

Çok güzel detaylı anlatmışsınız gayet net anlaşılıyor ama yapmak istediğiniz bana çok mantıklı gelmedi. A sütunundaki Tomruk numaraları H sütunundaki Tekrar Sayısı kadar alt alta tekrarlanırsa, 1 milyon 358 bin satırdan oluşan çalışma kitabı ortaya çıkar. Bu da dosyanın çalışması bakımından ne kadar sağlıklı olur bilemiyorum. Yapılmaz demiyorum yapılır ama bu beni aşıyor. Ama bu sitede bunu yapabilecek kaliteli ustalar var.

 

[kutluaye]

yanlış baktınız galiba h sütünü toplamı 2366 bu kadar satır alt alta gelecek ben o sıralamayı yapıyorum ancak devamı benim için zor sıralamanın yapılmış hali ekte

 

[Ömer]

Merhaba,
İstediğiniz bu mu?

Sub Duzenle()
   
    Dim i As Long, sat As Long, j As Integer, s As Integer

    Application.ScreenUpdating = False
    Range("J3:M" & Rows.Count).ClearContents
   
    For i = 3 To Cells(Rows.Count, "H").End(xlUp).Row
        If Cells(i, "H") > 0 Then
            sat = Cells(Rows.Count, "K").End(xlUp).Row + 1
            s = 0
            Cells(sat, "K").Resize(Cells(i, "H"), 1) = Cells(i, "A")
           
            For j = 2 To 7
                If Cells(i, j) > 0 Then
                    Cells(sat + s, "L").Resize(Cells(i, j), 1) = Split(Cells(2, j), "x")(0) + 0
                    Cells(sat + s, "M").Resize(Cells(i, j), 1) = Split(Cells(2, j), "x")(1) + 0
                    s = s + Cells(i, j)
                End If
            Next j
        End If
    Next i

    [J3] = 1: Range("J3:J" & sat + s - 1).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
    Application.ScreenUpdating = True
   
End Sub

 

[kutluaye]

yardımız için teşekkür ederim ancak bunu nasıl uygularım

 

[Ömer]

Çalışmanız açıkken Alt+F11 ile VBA ekranın geçin, Insert menüsünden Module ekleyin. Module1 eklenecektir, içine girip verdiğim kodları bu sayfaya yapıştırın.

Daha sonra VBA ekranını kapatın, Alt+F8 ile kodları çalıştırabilir, yada bir buton/resim/şekil ekleyip, eklediğiniz nesneye sağ klik yapıp "makro ata" ile duzenle kodlarını atayabilirsiniz. Artık bu nesneye tıkladığınız da çalışır.

Bu işlemlerden sonra dosyanızı farklı kaydet bölümünden kayıt türünü makro içerebilen kitap olarak seçmeyi atlamayın.

İşlem detayını anlamanız için yazdım, deneyin olmaz ise ben dosyanızı eklerim.

 

[kutluaye]

çok teşekkür ederim beni buyuk dertten kurtardınız

problemsiz çalışıyor