Satırdaki yinelenen kelimeleri kaldırma ve ayırma

[unutkan518]

[TR][TD]
Arkadaşlar Merhaba

Aşağıdaki gibi bir listem var. A sutununda veriler var. Parçalayıp B,C,D sutununa dağıtmak istiyorum. Yardımcı olabilirseniz sevinirim.

548 sk.No 8 Abdurrahim Gizer Apt. D blok kat.52 D.78 Polatlı Ankara Polatlı Ankara


Olması gereken (b sutunu)
[/TD][/TR]
[TR][TD]
548 sk.No 8 Abdurrahim Gizer Apt. D blok kat.52 D.78

Olması Gereken (c sutunu)
[/TD][/TR]
[TR][TD]
Polatlı

Olması Gereken (D sutunu)
Ankara

frumdan bulduğum bu kodu kullanmıştım ama tam istediğim gibi olmadı.
Sub SON_KELİME()
For sat = 1 To Cells(Rows.Count, "A").End(3).Row
Set brnn = Cells(sat, "A").Find(" ", , , xlPart)
If Not brnn Is Nothing Then
brn = WorksheetFunction.Search(" ", VBA.StrReverse(brnn), 1)
cc = Len(Cells(sat, "A")) - brn

Cells(sat, "B") = Mid(Cells(sat, "A"), Len(Cells(sat, "A")) - brn + 2, brn)
Cells(sat, "A") = Mid(Cells(sat, "A"), 1, Len(Cells(sat, "A")) - brn)
Else
Cells(sat, "B") = Cells(sat, "A"): Cells(sat, "A") = ""
End If
Next: brnn = Empty
MsgBox "İşlem tamamlandı.", vbInformation, "...::... Ö. BARAN ...::..."
End Sub

[/TD][/TR]

 

[alicimri]

Aşağıda kodu deneyin.

Sub ayır()
For e = 2 To Cells(Rows.Count, 1).End(3).Row
huc = Range("a" & e).Value
For i = Len(huc) To 1 Step -1
If IsNumeric(Mid(huc, i, 1)) Then
Exit For
End If
Next
Range("B" & e).Value = Trim(Mid(huc, 1, i))
Range("C" & e).Value = Split(Trim(Mid(huc, i + 2, 100)), " ")(0)
Range("D" & e).Value = Split(Trim(Mid(huc, i + 2, 100)), " ")(1)
Next
End Sub

 

[unutkan518]

Aşağıda kodu deneyin.

Sub ayır()
For e = 2 To Cells(Rows.Count, 1).End(3).Row
huc = Range("a" & e).Value
For i = Len(huc) To 1 Step -1
If IsNumeric(Mid(huc, i, 1)) Then
Exit For
End If
Next
Range("B" & e).Value = Trim(Mid(huc, 1, i))
Range("C" & e).Value = Split(Trim(Mid(huc, i + 2, 100)), " ")(0)
Range("D" & e).Value = Split(Trim(Mid(huc, i + 2, 100)), " ")(1)
Next
End Sub

Satırların bazılarında kayma oluştu. D sutunundan sonra birkaç bölümleme daha yapılması lazım gibi
Sanırım farklı bir yöntem uygulamak gerekiyor.

 

[ferhan.ozturk]

Merhaba, yazdığınız kodu sütunlar içinde yer alan belirli isimlere göre ayırabilir miyiz? Örneğin, elimdeki veri listesinde X ve Y sütunlarında veri noktaları yer almakta ve her bir serinin başında X ve bir isim yer almakta. Her dizinin başında bulunan X satırından bir sonraki X satırına kadar olan kısımları ayrı ayrı kaydedebilir miyiz?