Verileri istenilen şekilde düzenleme

[agahozlu]

Öncelikle burada yeni olduğumu (dışarıdan takip ediyordum fakat faal olmak bugüne kısmetmiş ) belirterek herkese merhaba diyorum.


Eklediğim dosyada 7 sütunlu bir excel tablosu var. Dosyadaki verileri tartım programı vasıtası ile otomatik olarak excel'e atıyorum. Yapmak istediğim olayı ise şöyle anlatayım.

İlk sütunda: DN 2040, DN 2031 ... diye referansları ifade eden veriler
İkinci sütunda: 8, 10,5 .. diye satır numaralarını ifade eden veriler
Üçüncü sütunda: Lot-2,Lot-1... veya lot olmayan yani - diye veriler
Dördüncü sütunda: White, purple... diye renkleri ifade eden veriler
Beşinci sütunda: Her ürünümün numarası var
Altıncı sütunda: Her ürünün net kilosu
Yedinci sütunda ise her ürünün brüt kilosu var.

İkinci sayfada şöyle bir tablo elde etmek istiyorum;

Tabloda verileri;
ref.no / satır no/lot no /Renk /top adedi/ net kilo/ brüt kilo
DN 2031 / 8 / LOT-2 / WHITE / 8 / 160,25 / 160,25
DN 2031/ 8 / LOT-3 / WHITE/ 17 / 358,90 /358,90

olacak şekilde düzenlemek istiyorum.

Yardımcı olmanızı rica ediyorum.

 

[N.Ziya Hiçdurmaz]

yanıt

TABLO isminde sayfa oluşturup kodu deneyiniz.

Sub test()
Dim sat As Integer
Dim s As Integer
s = 1
Set a = Sheets("tüm liste")
Set b = Sheets("TABLO")
    For sat = 2 To a.Cells(65536, "a").End(xlUp).Row
        b.Cells(s, "a") = a.Cells(sat, "a") & " / " & a.Cells(sat, "b") & " / " & a.Cells(sat, "c") _
        & " / " & a.Cells(sat, "d") & " / " & a.Cells(sat, "e") & " / " & a.Cells(sat, "f") & " / " & a.Cells(sat, "g")
        s = s + 1
    Next
End Sub

 

[Ömer]

Merhaba,

Ben soruyu, Sayın N.Ziya Hiçdurmaz'dan daha farklı algıladım.

Alternatif olsun.

Önce ozet isminde bir sayfa açın, daha sonra aşağıdaki kodları Module kopyalarak çalıştırınız.

Sub Duzenle()
Dim St As Worksheet, i As Long, son As Long
   
Set St = Sheets("tüm liste")
 
Application.ScreenUpdating = False
 
Sheets("ozet").Select
Cells.Clear

St.Range("F1:G1").Copy Range("F1")
Range("E1") = "Adet"

    St.Columns("A:D").AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("A1"), Unique:=True
 
son = Cells(Rows.Count, "A").End(xlUp).Row
 
    For i = 2 To son
        Cells(i, "E") = Evaluate("=DCount('tüm liste'!A:G,5,A1:D" & i & _
                        " )-Sum(E1:E" & i - 1 & ")")
        Cells(i, "F") = Evaluate("=Dsum('tüm liste'!A:G,6,A1:D" & i & _
                        " )-Sum(F1:F" & i - 1 & ")")
        Cells(i, "G") = Evaluate("=Dsum('tüm liste'!A:G,7,A1:D" & i & _
                        " )-Sum(G1:G" & i - 1 & ")")
    Next i
 
Cells.EntireColumn.AutoFit
Range("A1:G" & son).Borders.LineStyle = 1
 
Application.ScreenUpdating = True
    
End Sub

.

 

[agahozlu]

Yazdığınız makro çalıştı sağolun fakat benden dolayı yanlış anlaşılma olmuş galiba.

Öncelikle DN 2031 BİR HÜCREDE 8 YANINDAKİ HÜCREDE LOT-2 YANINDAKİ HÜCREDE OLACAK..

BİR DE DÜZENLEME ŞU ŞEKİLDE OLACAK ( EKTE GÖNDERİYORUM)

 

[agahozlu]

Ömer Bey sizin anladığınız şekil benim anlatmak istediğimdi.Yazdığınız makro çalıştı ve bir eksik ile istediğim şekilde oldu. Top adedi olarak istediğim kısım sizin yazdığınız makroda yok. Onu ekleme imkanımız var mı acaba?

Yani ; REFERANS NUMARASI DN 2031 SATIRI 8 LOT NUMARASI LOT-2 RENGİ WHITE OLAN TOPLARI SAYIP TOP ADEDİ SÜTUNUNA YAZACAK (İLK SATIR İÇİN 8 OLACAK)

 

[Ömer]

#3 numaralı mesajı yeniden düzenledim. Tekrar denermisiniz.

.

 

[agahozlu]

Ziya bey ilgilendiğiniz için teşekkürler.

Ömer bey kısa sürede verdiğiniz çözüm için çok sağolun. Allah razı olsun.

 

[azap59]

Merhaba,

Bu türden bilgileri pivot table kullanarak yaparsanız daha iyi olur.İstedeğiniz zaman refresh yapmanız yeterlidir.Bir inceleyin isterseniz.

Syg.