SAĞDAN BOŞLUĞA KADAR VERİ AL

[ayşe006]

arkadaşlar elimde isim soyisim listesi var metini sutuna çevirdiğimde çok eziyet çekiyorum. üç dört isimli kişiler var sadece soyadlarını sağdan boşluğa kadar ayırmak istiyorum. bi formül yada makro bilen varmı acaba sitede aradım bulamadım.

 

[çıtır]

Ad ve Soyadların A2 hücresinden başladığı varsayılmıştır.B2 hücresine kopyalayınız aşağı çekerek çoğlatınız.Soyadları alır.

=PARÇAAL(A2;1+BUL("*";YERİNEKOY(A2;" ";"*";UZUNLUK(A2)-UZUNLUK(YERİNEKOY(A2;" ";""))));255)

 

[ayşe006]

çok güzel oldu evdeki hesap çarşıya uymadı A sütünün da soyadı kaldı "murat karaca karaca" oldu. makro var mıdır sadece sağdan soyadı ayıran.

 

[anemis]

Birkaç deneme yapabilmek için örnek dosya yüklemenizi rica ederim. dosya.tc gibi bir siteye yükleme yapabilrsiniz.

 

[çıtır]

Sayfa1,A2 hücresinden itibaren ad soyad yazılı ise, A2 de ad B2 soyad oluşur.Deneyiniz.

Sub Adsoyad()
Dim s1 As Worksheet
Dim i As Integer
Dim cevap As Integer
Set s1 = Sheets("Sayfa1")
say = s1.Cells(65336, "A").End(3).Row
tek = WorksheetFunction.CountA(s1.Range("B2:B1000"))
If tek > 0 Then
cevap = MsgBox("İşlem yapılmış,tekrar işlem yapılsını istiyor musunuz?", vbYesNo + vbQuestion, "ONAY")
End If
If cevap = vbNo Then
    MsgBox "İşleminiz iptal edilmiştir."
 Exit Sub
Else
s1.Range("B2:B" & say).ClearContents
For i = 2 To say
son = Len(s1.Range("A" & i)) - Len(WorksheetFunction.Substitute(s1.Range("A" & i), " ", ""))
If son = 0 Then GoTo 10
yeni = WorksheetFunction.Substitute(s1.Range("A" & i), " ", ",", son)
Ads = Split(yeni, ",")
s1.Cells(i, 2) = Ads(1)
s1.Cells(i, 1) = Ads(0)
10:
Next i
End If
End Sub

 

[ayşe006]

ellerinize sağlık çok güzel oldu

 

[çıtır]

ellerinize sağlık çok güzel oldu

Dönüş yaptığınız için teşekkür ederim.Tekrar, tekrar işlem yapmamak için.Soru mesajı ekleyerek kodu yeniledim.Kolay gelsin.