Hücre içerisinde birden fazla değerleri ayırma makrosu

[yasin85]

Sn. Uzman Arkadaşlar,

Hücre içersin de bulunan simgeler (''['') (''<br />'')('':'') ve hücre içerisinde Alt+Enter yapılarak aynı hücrenin alt kısmına yazılmış verileri de yan sütuna ayırması gerekli


Örnek 1

aşağıda link ekledim oradan dosyaya ulaşa bilirsiniz sayfa1 makro yapılması gereken alan örnek sayfasıda nasıl istediğimi simgeliyor..

Makro tarama yapacağı sütunlar B,C,D,E,F,G,H,I,K bu sütunlarda 7000 satır aşağı inmesi gerek sonrasında yan yana aktarılan veriler üst üste yazılmaması için her hücre için yan tarafa hücre pay verilmesi gerek yani her ayrımda 150 yan hücre sonra başlaması lazım.

Sonrasında yan tarafa boş oluşan hücreleri silip dolu olan verileri yan tarafa getirmesi gerek
ve son olarak iki aynı değeri yan yana bulunan hücreleri silip tek değer haline getirmek.

http://s8.dosya.tc/server/mxj6ze/makrolazim.rar.html

Şimdiden teşekkürler

 

[alicimri]

Bir şeyler yaptım ama imkansız bir işe girişmişsiniz galiba bu bilgilerin kaynağı nedir.

Sub test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("örnek")
s2.Cells.ClearContents
satir = s1.Range("a1").CurrentRegion.Rows.Count
sutun = s1.Range("a1").CurrentRegion.Columns.Count
For i = 2 To satir
For e = 1 To sutun
Top = Top & bol(s1.Cells(i, e)) & "^"
Next
s2.Cells(i, 1).Value = Top
Top = ""
Next
End Sub
Function bol(laf)
b = Replace(Replace(Replace(Replace(laf, "[", "^"), "<br />", "^"), " : ", "^"), Chr(10), "^")
bol = b
End Function

örnek sayfasında "^" ile sütunlara bölün.

 

[yasin85]

Bir şeyler yaptım ama imkansız bir işe girişmişsiniz galiba bu bilgilerin kaynağı nedir.

Sub test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("örnek")
s2.Cells.ClearContents
satir = s1.Range("a1").CurrentRegion.Rows.Count
sutun = s1.Range("a1").CurrentRegion.Columns.Count
For i = 2 To satir
For e = 1 To sutun
Top = Top & bol(s1.Cells(i, e)) & "^"
Next
s2.Cells(i, 1).Value = Top
Top = ""
Next
End Sub
Function bol(laf)
b = Replace(Replace(Replace(Replace(laf, "[", "^"), "<br />", "^"), " : ", "^"), Chr(10), "^")
bol = b
End Function

örnek sayfasında "^" ile sütunlara bölün.

-
Sn. AliCimri Hocam,

'' : '' olanlar ayrılmamış bende onları tümünü '';'' olarak değiştirdim sonrasında metni sütunlara dönüştür işlemini yaptım..

İşlemde Sınırlandırılmış alanı seçip devam ettim
Sekme, Noktalı Virgül, Diğer ("^") şeklinde ayırma işlemini gerçekleştirdim.

Sonra fark ettiğim 2 detayı sizle paylaşayım..

* Metne sütunlara dönüştürdüğüm de bütün hücrelerin metin olması gerekli fakat sayı olarak geliyor tek tek manuel yaptığımda da arada kaçaklar oluyor ve bazı sayıların başında ''0'' olması gerekli onlar uçuyor liste çok olduğundan dolayı kaçırıyorum hangisinde ''0'' var mı yok mu diye Bunun için tüm hepsini metin olarak yukarıda yazdığım ayırma kriterlerine uygun olarak sizin desteğini vere bileceğiniz bir durum ola bilir mi?


* Diğer konuda daha önce yaptığınız makroyu buna uyarlaya bilirmisiniz (Yan Yana sütunlarda aynı değerlere sahip verilerin 2 ve fazla olan hücrelerde 1 tanesini bırakıp diğerlerini hücre sil ile sol tarafa kaydırmak istiyorum..

Diğer sorduğunuz sorunun cevabını da mesaj atacağım..