• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Adı küçük soyadı büyük harfle yazdırmak

  • Konbuyu başlatan Konbuyu başlatan mor45
  • Başlangıç tarihi Başlangıç tarihi
M

mor45

Katılım
30 Eylül 2005
Mesajlar
303
Excel Vers. ve Dili
2003 excel türkçe
Bir sütünda Ad ve sayadlar büyük harflerle yazılmış vaziyette var (İHSAN ADALAR) olarak 1000 yakın kişi Bu sütündaki kişilyeren isimlerini küçük harfle soyadlarınıda büyük harafle yazmasını istiyorum (İhsan ADALAR) gibi.
Lütfen Yardım.
 
Merhaba,

Sütun üzerinde doğrudan yapmak istiyorsanız ekteki dosyayı inceleyiniz. A sütunu için geçerlidir.

Kod: 
Sub soyad_ayir()
For i = 1 To Cells(65536, 1).End(xlUp).Row
    Ad = ""
    Soyad = ""
    a = Split(Cells(i, "A"), " ")
    For j = 0 To UBound(a) - 1
        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
Next i
End Sub
 
Hocam a1:a100 aralığındaki aşağıdaki verileri
hüseyin SayAr
Necdet Yesertener
Ahmet GüllÜOğlu
Mustafa Kemal Atatürk

vs şeklinde giden hatalıda yazılmış olan isimleri

yine a1:a100 aralığına
Hüseyin SAYAR
Necdet YESERTENER
Ahmet GÜLLÜOĞLU
Mustafa Kemal ATATÜRK
şeklinde yazacak makro nedir?

Sayın LeventM in özel mneü uygulamasında olduğu gibi yani seçili alanda işlemi yapacak
Kod: 
Sub BHARF()
Dim x As Range
On Error Resume Next
If Selection.Count > 100 Then
MsgBox "Fazla Alan Seçtiniz.", vbCritical + vbDefaultButton1 + vbOKOnly, "UYARI"
Exit Sub
End If
For Each x In Selection
x.Value = UCase(Replace(Replace((x.Value), "ı", "I"), "i", "İ"))
Next
End Sub
Saygılarımla
 
Son düzenleme:
Sayın Necdet Yesertener, paylaşım için teşekkürler. Elleriniz dert görmesin.
 
Kod: 
Sub AdNormSoyadBuyuk()
Dim x As Range
On Error Resume Next
    
    If Selection.Count > 100 Then
        MsgBox "Fazla Alan Seçtiniz.", vbCritical + vbDefaultButton1 + vbOKOnly, "UYARI"
        Exit Sub
    End If
    
    For Each x In Selection
        Ad = ""
        Soyad = ""
        a = Split(x.Value, " ")
        
        For j = 0 To UBound(a) - 1
            Ad = Trim(Ad & " " & a(j))
        Next j
    
        Soyad = Trim(a(UBound(a)))
        Ad = Evaluate("=PROPER(""" & Ad & """)")
        Soyad = Evaluate("=UPPER(""" & Soyad & """)")
        x.Value = Ad & " " & Soyad
    Next
End Sub

şeklinde ben yaptım çalışıyor şimdilik hata almadım
 
Sayın YEŞERTENER
İnanınki gönderdiğiniz minicik bir dosyayla özellikle biz sağlık sektöründeki memurların başının belası olan bir sorunu kökten çözdünüz.Neydi o canım öyle CAPS LOCK bas büyük bir daha bas küçük.ALLAH razı olsun.
Saygılarımla.
 
Necdet_Yesertener' Alıntı:
Merhaba,

Sütun üzerinde doğrudan yapmak istiyorsanız ekteki dosyayı inceleyiniz. A sütunu için geçerlidir.

Kod: 
Sub soyad_ayir()
For i = 1 To Cells(65536, 1).End(xlUp).Row
    Ad = ""
    Soyad = ""
    a = Split(Cells(i, "A"), " ")
    For j = 0 To UBound(a) - 1
        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
Next i
End Sub
Genişletmek için tıkla ...

Bu yapılanlar için teşekkür ediyorum
işimi gördü.
Ben size şunu sormak istiyorum hazırlanan makroyu exelde bir hüçrede çalışması için onu oraya nasıl monta ediyorsunuz bana açıklarmısınız. Sizin dosyanızda (adını yazım düzeni,Soyadını Büyük yap) denen yeri nasıl yaptınız .
Açıklarsanız sevinirim.
 
Merhaba,

Elimden geldiğince açıklamaya çalışayım. Yanlışım varsa arkadaşlar düzeltir.


Kod: 
Sub soyad_ayir()
For i = 1 To [A65536].End(3).Row
    Ad = ""
    Soyad = ""
    a = Split(Cells(i, "A"), " ")   [COLOR=seagreen]'-- Hücre değerini boşluklara göre dizine çıkartıyor[/COLOR]
    For j = 0 To UBound(a) - 1      [COLOR=seagreen]' dizi elemanından 1 eksiği Ad olacağı varsayıma göre döngüye sokularak Ad belirleniyor[/COLOR]
        Ad = Trim(Ad & " " & a(j))  [COLOR=seagreen]'Dizinin Son elemanı hariç diğerleri birleştiriliyor (ki bu Ad oluyor)[/COLOR]
    Next j
 
    Soyad = Trim(a(UBound(a)))      [COLOR=seagreen]'Dizinin Son elemanını verir (ki bu da Soyaddır)[/COLOR]
    Ad = Evaluate("=PROPER(""" & Ad & """)")        [COLOR=seagreen]'Adına yazım.düzeni (Proper) uygulanıyor[/COLOR]
    Soyad = Evaluate("=UPPER(""" & Soyad & """)")   [COLOR=seagreen]'Soyadına BÜYÜKHARF (Upper) uygulanıyor[/COLOR]
    Cells(i, "A") = Ad & " " & Soyad                [COLOR=seagreen]'Aynı hücrede ad ve soyad birleştiriliyor[/COLOR]
Next i
End Sub
 
Excel sayfasında bir hücreye koymuş olduğun (derleme kutusunu ) olan yeri nasıl yapıştırdın bunu anlatmanızı istemiştim yada ben anlatamadım.
 
Necdet_Yesertener' Alıntı:
Merhaba,

Elimden geldiğince açıklamaya çalışayım. Yanlışım varsa arkadaşlar düzeltir.


Kod: 
Sub soyad_ayir()
For i = 1 To [A65536].End(3).Row
    Ad = ""
    Soyad = ""
    a = Split(Cells(i, "A"), " ")   [COLOR=seagreen]'-- Hücre değerini boşluklara göre dizine çıkartıyor[/COLOR]
    For j = 0 To UBound(a) - 1      [COLOR=seagreen]' dizi elemanından 1 eksiği Ad olacağı varsayıma göre döngüye sokularak Ad belirleniyor[/COLOR]
        Ad = Trim(Ad & " " & a(j))  [COLOR=seagreen]'Dizinin Son elemanı hariç diğerleri birleştiriliyor (ki bu Ad oluyor)[/COLOR]
    Next j
 
    Soyad = Trim(a(UBound(a)))      [COLOR=seagreen]'Dizinin Son elemanını verir (ki bu da Soyaddır)[/COLOR]
    Ad = Evaluate("=PROPER(""" & Ad & """)")        [COLOR=seagreen]'Adına yazım.düzeni (Proper) uygulanıyor[/COLOR]
    Soyad = Evaluate("=UPPER(""" & Soyad & """)")   [COLOR=seagreen]'Soyadına BÜYÜKHARF (Upper) uygulanıyor[/COLOR]
    Cells(i, "A") = Ad & " " & Soyad                [COLOR=seagreen]'Aynı hücrede ad ve soyad birleştiriliyor[/COLOR]
Next i
End Sub
Genişletmek için tıkla ...

hocam açıklamalarınız için teşekkür ederimbana hücredeki kelime sayısını söyleyen kod lazım konu ile alakalı ama ben çözemedim yardımcı olabilirmisiniz?
 
Merhaba,

Kod: 
Sub soyad_ayir()
a = Split([A1], " ")
MsgBox UBound(a)
End Sub

kodda A1 hücresindeki ad ve soyadın kaç sözükten oluştuğunu söyler.

Necdet Yeşertener = 1
Mustfa Kemal Atatürk = 2 değerini verir

(Dizinin 0 dan başladığını düşünmek gerek)
 
Sayın Neclet Yesertener ve hsayar
Bu yazdınız kodu exele dosya olarak atarmısınız .
Ben bir acemi olarak öğrenmek istiyorum. Şimdden teşekkürler.
 
Buda formüllü çözüm olsun.

=YAZIM.DÜZENİ(SOLDAN(A1;BUL("/";YERİNEKOY(A1;" ";"/";UZUNLUK(A1)-UZUNLUK(YERİNEKOY(A1;" ";""))))-1))&" "&BÜYÜKHARF(SAĞDAN(A1;UZUNLUK(A1)-BUL("*";YERİNEKOY(A1;" ";"*";UZUNLUK(A1)-UZUNLUK(YERİNEKOY(A1;" ";""))))))
 
Değerli kardeşim Ali
eline sağlık güzel olmuş ve formul işliyor.
Allah razı olsun çok işime yarayacak.
 
yazdığınız anda dönüştürülmesini istiyorsanız;

Private Sub Worksheet_Change(ByVal Target As Range)
Set IntersectRng = Application.Intersect(Target, Range("A:Z"))
If Not IntersectRng Is Nothing Then
Target = WorksheetFunction.Proper(Trim(Target))
z = StrReverse(Target)
x = InStr(1, z, " ")
If x > 0 Then
y = Mid(z, 1, InStr(1, z, " "))
For i = 1 To Len(y)
c = c & WorksheetFunction.Proper(Mid(y, i, 1))
Next
Target = Mid(Target, 1, Len(Target) - x) & StrReverse(c)
End If
End
End If
Set IntersectRng = Nothing
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
Set IntersectRng = Application.Intersect(Target, Range("A:Z"))
If Not IntersectRng Is Nothing Then
Target = WorksheetFunction.Proper(Trim(Target))
z = StrReverse(Target)
x = InStr(1, z, " ")
If x > 0 Then
y = Mid(z, 1, InStr(1, z, " "))
For i = 1 To Len(y)
c = c & WorksheetFunction.Proper(Mid(y, i, 1))
Next
Target = Mid(Target, 1, Len(Target) - x) & StrReverse(c)
End If
End
End If
Set IntersectRng = Nothing
End Sub
yazdığımız anda dönüşüyor tam istediğim gibi fakat belgenin tamamına uygulaymakta. ben bu kodun yalnız 1 hücrede geçerli olmasını istiyorum örnek H12 hücresinde
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst