Soyadına takı eklemek

[ASLAN7410]

Arkadaşlar hayırlı akşamlar. Yardım edecek arkadaşlara şimdiden çok teşekkür ederim.

Benim istediğim soyadına a, e, ne, na, ya, ye gibi takı gelmesini istiyorum.

Çok araştırdım ancak benim istediğim gibi bir şey bulamadım.

Örnek olarak A1 hücresine ASLAN yazdığımızda, B1 hücresine ASLAN'a yazmasını istiyorum.

A1 hücresi MERT, B1 hücresi MERT'e,
A1 hücresi ASLANOĞLU, B1 hücresi ASLANOĞLU'na,
A1 hücresine TAŞÇI, B1 hücresine TAŞÇI'ya,
A1 hücresine BİÇER, B1 hücresine BİÇER'e,
A1 hücresine EKİCİ, B1 hücresine EKİCİ'ye gibi olmasını istiyorum.

İnternette bir tane örnek buldum ancak bunu da benim istediğim şekle uyarlayamadım.

Örnek dosya ektedir.

http://s3.dosya.tc/server29/3QbdGF/Yeniklas_r.rar.html

 

[YUSUF44]

Aşağıdaki konuyu inceleyiniz:

Soyadına ek yapma

 

[1Al2Ver]

Merhaba,

Sayın Necdet Yeşertener'in uygulamasını revize edip sunuyorum,

Bir modüle kopyalayınız, A sütunundaki soyisimlere B sütununda ek yapıyor,

Option Compare Text
Sub Ekle()

Dim i As Long
Dim Harf1, Harf2, Harf3 As String

Application.ScreenUpdating = False

For i = 2 To [C65536].End(3).Row

    Harf1 = Right(Cells(i, "A"), 1)
    Harf2 = Left(Right(Cells(i, "A"), 2), 1)
    Harf3 = Left(Right(Cells(i, "A"), 3), 1)
    
    If Right(Cells(i, "A"), 4) = "OĞLU" Then
        Cells(i, "B") = Cells(i, "A") & "'NU"
    ElseIf Harf1 = "A" Or Harf1 = "I" Then
        Cells(i, "B") = Cells(i, "A") & "'YI"
    ElseIf Harf1 = "E" Or Harf1 = "İ" Then
        Cells(i, "B") = Cells(i, "A") & "'Yİ"
    ElseIf Harf1 = "O" Or Harf1 = "U" Then
        Cells(i, "B") = Cells(i, "A") & "'YU"
    ElseIf Harf1 = "Ö" Or Harf1 = "Ü" Then
        Cells(i, "B") = Cells(i, "A") & "'YÜ"
    ElseIf Harf2 = "A" Or Harf2 = "I" Then
        Cells(i, "B") = Cells(i, "A") & "'I"
    ElseIf Harf2 = "E" Or Harf2 = "İ" Then
        Cells(i, "B") = Cells(i, "A") & "'İ"
    ElseIf Harf2 = "O" Or Harf2 = "U" Then
        Cells(i, "B") = Cells(i, "A") & "'U"
    ElseIf Harf2 = "Ö" Or Harf2 = "Ü" Then
        Cells(i, "B") = Cells(i, "A") & "'Ü"
    ElseIf Harf3 = "A" Or Harf3 = "I" Then
        Cells(i, "B") = Cells(i, "A") & "'I"
    ElseIf Harf3 = "E" Or Harf3 = "İ" Then
        Cells(i, "B") = Cells(i, "A") & "'İ"
    ElseIf Harf3 = "O" Or Harf3 = "U" Then
        Cells(i, "B") = Cells(i, "A") & "'U"
    ElseIf Harf3 = "Ö" Or Harf3 = "Ü" Then
        Cells(i, "B") = Cells(i, "A") & "'Ü"
    End If
Next i

Application.ScreenUpdating = True

End Sub

 

[ASLAN7410]

Arkadaşlar ilginize teşekkür ediyorum.

Sayın Yusuf44, Altın Üye olmadığım için dosyaları göremedim.

Sayın 1Al2Ver arkadaşım bunu formülle yapabilir miyiz?

 

[Necdet]

Arkadaşlar ilginize teşekkür ediyorum.

Sayın Yusuf44, Altın Üye olmadığım için dosyaları göremedim.

Sayın 1Al2Ver arkadaşım bunu formülle yapabilir miyiz?

Altın üyelik toru topu 15 TL, 1 yıl için, bence üye olun kısıtlamalardan kurtulun.

 

[1Al2Ver]

Arkadaşlar ilginize teşekkür ediyorum.

Sayın Yusuf44, Altın Üye olmadığım için dosyaları göremedim.

Sayın 1Al2Ver arkadaşım bunu formülle yapabilir miyiz?

Merhaba,

Yapılabilir ancak ekli dosya ekleyemediğiniz ve indiremediğiniz için, anlatım yoluyla çok uzun olur, ad tanımla yardımcı sayfa veya sütunlar kullanma gibi süreçler var,

Müsait olduğumda size uygun bir dosya hazırlayıp dosya eklenebilen bir oluşuma ekleme yapmaya çalışırım,

Forum'da "Soyadına Ek Yapmak" şeklinde arama yapın, Sayın Necdet Yeşertener'in formüllü çözümünü de bulabilirsiniz,

Kolay gelsin.

 

[ASLAN7410]

Arkadaşlar ilginiz için çok teşekkür ediyorum.

Konuyu çözdüm.

 

[Necdet]

Merhaba,
e, i, in, de, den eklerini de getirecen KTF olabilir, saf halini aşağıda görebilirsiniz.

Function Ek(Sozcuk As String, Optional Ne As String = "E")
'e, i, in, de, den
    Dim Dizi_S      As Variant, _
        Dizi_E      As Variant, _
        Dizi_Den    As Variant, _
        Dizi_In    As Variant, _
        Dizi_Nin    As Variant, _
        Aranan      As Variant, _
        Sonuc       As Variant, _
        i           As Integer, _
        Durum       As Boolean
        
'    On Error Resume Next
    
    Dizi_S = Array("A", "E", "I", "İ", "O", "Ö", "U", "Ü")
    Dizi_E = Array("YA", "YE", "YA", "YE", "YA", "YE", "YA", "YE")
    Dizi_In = Array("IN", "İN", "IN", "İN", "UN", "ÜN", "UN", "ÜN")
    Dizi_Nin = Array("NIN", "NİN", "NIN", "NİN", "NUN", "NÜN", "NUN", "NÜN")
    Dizi_Den = Array("DAN", "DEN", "DAN", "DEN", "DAN", "DEN", "DAN", "DEN")
    
    For i = Len(Sozcuk) To 1 Step -1
        Aranan = Mid(Sozcuk, i, 1)
        Sonuc = Application.Match(Aranan, Application.Transpose(Dizi_S), 0)
        If Not IsError(Sonuc) Then
              MsgBox Aranan & " Dizide VAR! Sıra No : " & Dizi_Nin(Sonuc - 1)
              Ek = Dizi_Nin(Sonuc - 1)
              Exit For
        End If
    Next i
    
    Aranan = "C"
    
    'Sonuc = Application.VLookup(Aranan, Application.Transpose(Dizi), 1, 0)

End Function

 

[Necdet]

Necdet Bey fonksiyonu hücreye nasıl yazmalıyız.
Düzeltme: =Ek(a1) yazınca oldu

Merhaba,
fonksiyonun parametresi de var. Parametre belirtmezseniz E eki ekler,

E,İ,DE,DEN gibi

=Ek(A1;"E")

gibi kullanılmalı.