Satırdaki benzersiz değerleri sütuna dönüştürme

[Ukde]

Merhaba,
Ekteki dosyada görebileceğiniz gibi bir stok listesi var ve bu stok listesinde ürün özelliklerini satırlar halinde alıyor. Ve ürün özelliği kadar ürün adını kodunu vb. satırları çoğaltıyor. İstiyorum ki ürün özelliklerini benzersiz olarak sütunlara dönüştürsün ve satır sayısını tek satıra düşürsün. Yani (ozellik.Attribute:tanim) sütunundaki verileri benzersiz olarak sütunlara dönüştürsün ve (ozellik.Element:Text) sütunundaki ilgili özelliğin altına getirsin. Örnek olarak gönderdiğim dosyada özellik sayısı az ancak bazı ürünler var ki en az 15 satır. Normalde 4000 olan stok sayısı nerdeyse 42000 satıra çıkıyor. Bu konuda yardımcı olabilirseniz çok sevinirim.

https://1drv.ms/x/s!AsLom5zhtqRcgUpRzTxY_2pvYwK5

 

[Haluk]

Eklediğiniz dosyadaki veriler sanki bir XML dosyasından alınmışa benziyor.

XML dosyasının kendisini ekleseniz belki daha iyi olur.

.

 

[alicimri]

Yeni isimli bir sayfa oluşturup verileri düzenliyor

Sub a()

  Sheets.Add
  ActiveSheet.Name = "Yeni"
say = Sheets("Sayfa1").Range("N65536").End(3).Row
Say1 = 1
For i = 2 To say
say2 = Sheets("Yeni").Range("A65536").End(3).Row + 1
If Application.CountIf(Sheets("Yeni").Rows(1), Sheets("Sayfa1").Range("N" & i)) = 0 Then
Sheets("Yeni").Cells(1, Say1) = Sheets("Sayfa1").Range("N" & i)
Say1 = Say1 + 1
End If
aa = Sheets("Yeni").Rows(1).Find(What:=Sheets("Sayfa1").Range("N" & i)).Column
Sheets("Yeni").Cells(say2, aa) = Sheets("Sayfa1").Range("O" & i)
Next
Sheets("Yeni").Range(Cells(2, 2), Cells(2, Say1 - 2)).Delete Shift:=xlUp
 Columns("A:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
 Sheets("Sayfa1").Range("A1:M1").Copy Sheets("Yeni").Range("A1")
 For k = 2 To say
 If Sheets("Sayfa1").Range("A" & k) <> Sheets("Sayfa1").Range("A" & k - 1) And Sheets("Sayfa1").Range("A" & k) = Sheets("Sayfa1").Range("A" & k + 1) Then
  Sheets("Sayfa1").Range("A" & k & ":M" & k).Copy Sheets("Yeni").Range("A" & Sheets("Yeni").Range("A65536").End(3).Row + 1)
 End If
 Next
End Sub

 

[Ukde]

Merhaba,

Bu kod bütün verileri sütunlara dönüştürüyor. Oysaki ben sadece belirttiğim 2 sütunu benzersiz şekilde sütunlara dönüştürsün istiyorum.

Yani N sütununu benzersiz şekilde yan yana sütuna dönüştürsün ve O sütunundaki veriyi N sütunundan oluşturduğu ilgili yeni sütununun altına yazsın.

Yeni isimli bir sayfa oluşturup verileri düzenliyor

Sub a()
  Sheets.Add
  ActiveSheet.Name = "Yeni"
say = Sheets("Sayfa1").Range("N65536").End(3).Row
Say1 = 1
For i = 2 To say
say2 = Sheets("Yeni").Range("A65536").End(3).Row + 1
If Application.CountIf(Sheets("Yeni").Rows(1), Sheets("Sayfa1").Range("N" & i)) = 0 Then
Sheets("Yeni").Cells(1, Say1) = Sheets("Sayfa1").Range("N" & i)
Say1 = Say1 + 1
End If
aa = Sheets("Yeni").Rows(1).Find(What:=Sheets("Sayfa1").Range("N" & i)).Column
Sheets("Yeni").Cells(say2, aa) = Sheets("Sayfa1").Range("O" & i)
Next
Sheets("Yeni").Range(Cells(2, 2), Cells(2, Say1 - 2)).Delete Shift:=xlUp
End Sub

 

[alicimri]

Tamda izah ettiğinizi yapıyor ama siz en iyisi olması gereken örnekleri içeren bir dosya eklerseniz.

 

[Ukde]

Merhaba

Örnek dosya aşağıdaki gibi.

https://1drv.ms/x/s!AsLom5zhtqRcgUtChW6CIFsapVwj

Tamda izah ettiğinizi yapıyor ama siz en iyisi olması gereken örnekleri içeren bir dosya eklerseniz.

 

[alicimri]

Benim örneğimde Sayfa2 de oluşan tablonun ön tarafına, Sayfa1 deki A:M arası kayıtlardan birer tanesi mi alsın

 

[alicimri]

#3 nolu mesajdaki kodu değiştirdim.

 

[Haluk]

Merhaba;

Ufak bir bilgi:

4394 adet ürün cinsi için belirtmiş olduğunuz benzersiz "Özellik" tanımlamaları yaklaşık olarak 550 adet olarak bulunmuştur.

Yani, ekli resimde görüldüğü gibi; 4394 adet ürün cinsi için yaklaşık olarak 550 adet benzersiz "Özellik" vardır.

.

 

[Ukde]

Haluk Bey
Bu kod barkod numaralarından başlayarak sütunlara dönüştürüyor. Oysaki ben sadece
Aşağıdaki iki sütunu bölsün istiyorum.

Yani işlem sadece N ve O sütunlarında yapılacak.
ozellik.Attribute:tanim // ozellik.Element:Text

Kategori: Güç Kablosu
Marka: S-Link
Model Link: http://111
Model Soft: Deneme1
Model Dosya: Deneme2

#3 nolu mesajdaki kodu değiştirdim.

 

[alicimri]

Merak ettim #3 nolu mesajdaki kodu çalıştırınca Yeni sayfada istediğiniz tablo oluşmuyor mu?

 

[Haluk]

........
Aşağıdaki iki sütunu bölsün istiyorum.

Yani işlem sadece N ve O sütunlarında yapılacak.
ozellik.Attribute:tanim // ozellik.Element:Text

Kategori: Güç Kablosu
Marka: S-Link
Model Link: http://111
Model Soft: Deneme1
Model Dosya: Deneme2

Bahsettiğim yaklaşık 550 adet benzersiz özellik bunlar zaten.....

1-Kategori
2-Marka
3-Model Link
4-Model Soft
5-Model Dosya
6-Üretici Kodu
7-Baskı Kapasitesi
8-Uyumlu Ürünler
9-Pin Sayısı
10-Kolon
11-Renk Özelliği
12-En Yüksek Hızı (cps)
......
....
...
..
539-Teknolojisi
540-Maks. Lamba Ömrü (Saat)
541-Kontrast
542-Lamba Tipi
543-Zoom
544-Uzaktan Kumanda
545-Lens
546-Video Uyumluluk
547-Keystone Düzeltme
548-Projeksiyon Mesafesi
549-PCI slot tipi

Yukarıdaki listede, 4394 adet ürün için yaklaşık 550 adet özellik var.....

.

 

[Ukde]

Hocam,
Çok teşekkürler şu an çalıştı. Bende farklı bir sütun varmış.

Merak ettim #3 nolu mesajdaki kodu çalıştırınca Yeni sayfada istediğiniz tablo oluşmuyor mu?

 

[Haluk]

@Ukde:

Sorununuz tam olarak çözüldü mü bilmiyorum.

Aşağıdaki ekran görüntüsünde belirtildiği gibi bir dosya hazırladım. Yaklaşık 4390 adet ürünün muhtelif özelliklerine ait başlıklar benzersiz olarak (yaklaşık olarak 550 adet civarında) XML dosyasından (internet ortamında) alınarak, Excel'de sütün başlığı olarak yazdırılmakta, daha sonra tüm veriler ayrıştırılarak bu sütünların altına işlenmektedir.

Selamlar,




Başka bir ekran görüntüsü ...