ad-soyad ifaderinde tek karakterli ad kısaltmalarına . ekleyebilmek

Katılım
21 Kasım 2007
Mesajlar
39
Excel Vers. ve Dili
Excel 2003 Türkçe
Aslında başkıl yeterince özetliyor çıkmazımı. Ancak, yinede açayım.

Elimde iki kelimeden uzun ad girişleri olan bir liste var:
Ahmet V GEÇER
Veli C NURGİL
Olcay O YETER
...

Bu listede yer alan tek karakterli isim kısaltmalarının sonuna . koyabilmeyi istiyorum.
Ahmet V. GEÇER
Veli C. NURGİL
Olcay O. YETER
...

Bu işi makro-vba kullanarak nasıl yapılacağı hakkında bilgi sahibi olan varsa yardımcı olursa sevinirim.


Bul-Değiştir uygulamasında " ? " joker karakteriyle arama yaptırabildim. Ancak joker karakteri kullanarak . girişi sağlayamadım, " ?. " işe yaramadı yani.
 

Mahmut Kök

Özel Üye
Katılım
14 Temmuz 2006
Mesajlar
878
Excel Vers. ve Dili
Excel 2007 - Türkçe
Deneyiniz.

Kod:
Sub noktala()
On Error Resume Next
For a = 1 To [a65536].End(3).Row
    For b = 1 To Len(Cells(a, 1))
    If Mid(Cells(a, 1), b, 1) = " " Then
    If Mid(Cells(a, 1), b - 2, 1) = " " And Mid(Cells(a, 1), b - 1, 1) <> " " Then Cells(a, 1) = Left(Cells(a, 1), b - 1) & ". " & Right(Cells(a, 1), (Len(Cells(a, 1)) - b))
    End If
    Next
  Next
End Sub
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ekli dosyayı inceleyiniz.:cool:
Kod:
Sub z()
Range("B1:B65536").Clear
For i = 1 To Cells(65536, "A").End(xlUp).Row
deg = ""
    For s = 1 To Len(Cells(i, "A").Value)
        If sayac = 0 Then
            deg = deg & Mid(Cells(i, "A").Value, s, 1)
        End If
sayac = 0
        If s >= 2 And s < Len(Cells(i, "A").Value) Then
            If Mid(Cells(i, "A").Value, s - 1, 1) = " " And _
            Mid(Cells(i, "A").Value, s, 1) <> "" And _
            Mid(Cells(i, "A").Value, s + 1, 1) = " " Then
                deg = deg & "."
                sayac = 1
                
            End If
        End If
    Next s
    sayac = 0
    Cells(i, "B").Value = deg
Next i
End Sub
 
Katılım
21 Kasım 2007
Mesajlar
39
Excel Vers. ve Dili
Excel 2003 Türkçe
Sayın GİZLEN,

Bu kodlar ve emeğiniz için ne kadar teşekkür etsem az olur. Bilginize sağlık.
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
merhaba
syn Evren kodlar i&#231;in te&#351;ekk&#252;r, ar&#351;ivime att&#305;m.
Mustafa K Atat&#252;rk ad&#305;n&#305; Mustafa K. Atat&#252;rk olarak d&#252;zeltiyor,
ayn&#305; liste i&#231;ersinde M Kemal olsayd&#305; M. Kemal olarak nas&#305;l de&#287;i&#351;tiririz?
veya M Kemal Atat&#252;rk yerine M. Kemal Atat&#252;rk
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
merhaba
syn Evren kodlar için teşekkür, arşivime attım.
Mustafa K Atatürk adını Mustafa K. Atatürk olarak düzeltiyor,
aynı liste içersinde M Kemal olsaydı M. Kemal olarak nasıl değiştiririz?
veya M Kemal Atatürk yerine M. Kemal Atatürk
Mahmut beyin kodlarını bir deneseniz.:cool:
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
merhaba
syn mahmut k&#246;k'&#252;n kodlar&#305; g&#246;z&#252;mden ka&#231;m&#305;&#351;, en son syn evren gizlen'in kodlar&#305; oldu&#287;u i&#231;in ona bakm&#305;&#351;t&#305;m.
her iki arkada&#351;&#305;m&#305;zada te&#351;ekk&#252;r ederim, ellerine sa&#287;l&#305;k.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
merhaba
syn mahmut kök'ün kodları gözümden kaçmış, en son syn evren gizlen'in kodları olduğu için ona bakmıştım.
her iki arkadaşımızada teşekkür ederim, ellerine sağlık.
Rica ederim.
İyi çalışmalar.:cool:
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,455
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Daha önce ad küçük soyad büyük harfle yazan kodları aynı şekilde ek yaparak tek karakterli sözcüklere nokta koyan denememi sunuyorum.

Belki yararlı olur.

Kod:
Public Sub Düzelt()
For i = 2 To [A65536].End(3).Row
    Ad = ""
    Soyad = ""
    a = Split(Cells(i, "A"), " ")
    For j = 0 To UBound(a) - 1
        
        If Len(a(j)) = 1 Then a(j) = a(j) & ". "
        Ad = Trim(Ad & " " & a(j))
    Next j
    
    Soyad = Trim(a(UBound(a)))
    Ad = Evaluate("=PROPER(""" & Ad & """)")
    Soyad = Evaluate("=UPPER(""" & Soyad & """)")
    
    Cells(i, "A") = Ad & " " & Soyad & Ek
Next i
End Sub
 
Katılım
16 Kasım 2007
Mesajlar
700
Excel Vers. ve Dili
Office 2003 - Tr
Necdet Bey tam arad&#305;&#287;&#305;md&#305;. &#199;ok Te&#351;ekk&#252;r Ederim.
 
Üst