Firma Ünvanlarını İki Parça Halinde Ayırmak

[altan888]

Merhabalar ,

Ekteki listedeki firma ünvanları Tek Sütunda ve Tek Parça Halinde listelidir ancak ben FİRMA ÜNVANLARINI (İki ayrı Sütunda ve İki Parça Halinde olmasını istiyorum. Metni sütunları ayırma işlemini yapıyorum , ya firma ünvanını cümlede kaç kelime varsa o kadar sütuna bölüyor, yada kelimelerin bittiği yerden değilde tam ortasında bölerek yapıyor bu da anlamsız oluor, bunun bir kolay yolu veya fonksiyon, formül v.b. çözümü varmıdır, yardımcı olmanızı rica eder, şimdiden çok teşekkür ederim, İyi günler



İyi günler
Altan

 

[YUSUF44]

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub ayır()
For i = 3 To Cells(Rows.Count, "A").End(3).Row
    boşluk = Len(Cells(i, "A")) - Len(Replace(Cells(i, "A"), " ", ""))
    If boşluk = 1 Then
        Cells(i, "C") = Left(Cells(i, "A"), WorksheetFunction.Find(" ", Cells(i, "A")) - 1)
        Cells(i, "D") = Replace(Cells(i, "A"), Cells(i, "C"), "")
    ElseIf boşluk > 1 Then
        böl = Int(boşluk / 2)
        a = Split(Cells(i, "A"), " ")(böl)
        Cells(i, "C") = Left(Cells(i, "A"), WorksheetFunction.Find(a, Cells(i, "A")) - 1)
        Cells(i, "D") = Replace(Cells(i, "A"), Cells(i, "C"), "")
    Else
        Cells(i, "C") = Cells(i, "A")
    End If
Next
End Sub

 

[altan888]

Çözüm Süper Olmuş, Çok ama çok teşekkürler. Selamlar Saygılar

Çok teşekkürler