Aşağıdaki kod ile A sütununa birleşik yazılan ad ve soyadları, B sütununa isimler, C sütununa soyadı gelecek şekilde ayırabilirsiniz:
Sub EXCELCE_ADSOYAD_AYIR()
Dim BULENT, EXCELCE, ad As Long
Dim DEGIS, ADI As String
Dim AYIR() As String
Columns("B:C").ClearContents
'TÜRKÇE KARAKTER DEĞİŞTİR-EXCELCE.NET:
For BULENT = 1 To Cells(65536, 1).End(xlUp).Row
DEGIS = Cells(BULENT, 1).Value
DEGIS = VBA.Replace(DEGIS, "Ç", "C")
DEGIS = VBA.Replace(DEGIS, "ç", "c")
DEGIS = VBA.Replace(DEGIS, "Ğ", "G")
DEGIS = VBA.Replace(DEGIS, "ğ", "g")
DEGIS = VBA.Replace(DEGIS, "İ", "I")
DEGIS = VBA.Replace(DEGIS, "ı", "i")
DEGIS = VBA.Replace(DEGIS, "Ö", "O")
DEGIS = VBA.Replace(DEGIS, "ö", "o")
DEGIS = VBA.Replace(DEGIS, "Ü", "U")
DEGIS = VBA.Replace(DEGIS, "ü", "u")
DEGIS = VBA.Replace(DEGIS, "Ş", "S")
DEGIS = VBA.Replace(DEGIS, "ş", "s")
'YAZIM DÜZENİ-EXCELCE.NET:
DEGIS = StrConv(DEGIS, vbProperCase)
Cells(BULENT, 1).Value = DEGIS
Next BULENT
'AYIR:
For EXCELCE = 1 To Cells(65536, 1).End(xlUp).Row
AYIR = Split(Cells(EXCELCE, 1), " ")
KACBOSLUKVAR = UBound(AYIR)
If KACBOSLUKVAR = 0 Then
Cells(EXCELCE, 2).Value = Cells(EXCELCE, 1)
Else
Cells(EXCELCE, 3).Value = AYIR(KACBOSLUKVAR)
For ad = 0 To KACBOSLUKVAR - 1
ADI = ADI & AYIR(ad) & " "
Next ad
Cells(EXCELCE, 2).Value = ADI
End If
ADI = ""
Next EXCELCE
MsgBox "İşlem tamamlandı", vbInformation, "Excelce.Net"
End Sub