Bir Hücredeki Verileri Ayrıştırma

[badmad34]

Merhaba arkadaşlar,

Ekteki dosyadaki "CUSTOMER_MH" sayfasının F sütunundaki verileri inceleyelim. Burada ";" sembolüyle ayrılmış veriler göreceksiniz. Benim yapmak istediğim F sütununda bulunan verileri, G sütununa ayrıştırılmış biçimde taşımak. Ayrıştırma işlemi ";" sembolüyle yanyana dizilmiş olan tüm verilerin ";" sembolüne kadar olan kısmını almak G sütununda alt alta dizmek.

Örneğin;

F sütununda 5003;551BB;651BB; şeklinde tek hücrede bulunan bir veriyi,

G sütununa;
5003
551BB
651BB

şeklinde üç ayrı hücreye taşımak. Eğer F sütunundaki hücre boşsa herhangi bir işlem yapmasına gerek yok kodun. Nasıl yapılabilir?

 

[hamitcan]

Veri>Metni Sütunlara Dönüştür>Noktalı Virgül

 

[badmad34]

Öncelikle teşekkürler. Denedim fakat bu özellik verileri 3 ayrı kolona yaydı. Benim istediğim ise tek bir kolonda alt alta dizilmeleri. Bu özelliği kullanmayı iyi bilmediğimden de olabilir.

 

[hamitcan]

Sorunuzu, örnek dosyanız üzerinde gösterirseniz, yanlış anlaşılmalara sebep olmayacaktır.

 

[badmad34]

İlk mesajıma bakarsanız, ekli dosyamı göreceksiniz. Mesajımı zaten örnek dosya üzerinden yazmıştım. Bakabilir misiniz tekrar?

 

[halit3]

Merhaba arkadaşlar,

Ekteki dosyadaki "CUSTOMER_MH" sayfasının F sütunundaki verileri inceleyelim. Burada ";" sembolüyle ayrılmış veriler göreceksiniz. Benim yapmak istediğim F sütununda bulunan verileri, G sütununa ayrıştırılmış biçimde taşımak. Ayrıştırma işlemi ";" sembolüyle yanyana dizilmiş olan tüm verilerin ";" sembolüne kadar olan kısmını almak G sütununda alt alta dizmek.

Örneğin;

F sütununda 5003;551BB;651BB; şeklinde tek hücrede bulunan bir veriyi,

G sütununa;
5003
551BB
651BB

şeklinde üç ayrı hücreye taşımak. Eğer F sütunundaki hücre boşsa herhangi bir işlem yapmasına gerek yok kodun. Nasıl yapılabilir?

Bu kodu denermisiniz.

Sub sırala()
sat = 2
For r = 1 To Worksheets(ActiveSheet.Name).[f65536].End(3).Row
sut = 1
alan1 = Len(Worksheets(ActiveSheet.Name).Cells(r, "f").Value)
If alan1 <> 0 Then
deg = 0
For i = 1 To alan1
If Mid((Worksheets(ActiveSheet.Name).Cells(r, "f").Value), i, 1) = ";" Then
deg = 1
End If
If deg = 1 Then
Worksheets(ActiveSheet.Name).Cells(sat, "g").Value = Mid((Worksheets(ActiveSheet.Name).Cells(r, "f").Value), sut, i - sut)
sut = i + 1
sat = sat + 1
deg = 0
End If
Next i
End If
Next r
End Sub