Cümlenin ilk harfini büyük harf yapmak

[ASLAN7410]

Merhaba hayırlı akşamlar.

Ekte gönderdiğim excel dosyasının Sayfa1'de H7 ile H100 arasındaki hücrelere bilgi giriyorum, hücreden çıktığımda cümlenin ilk harfini ve cümle içerisindeki . (nokta), soru işareti ve ünlem işaretinden sonraki kelimenin ilk harfi de büyük olsun istiyorum. Bu işlemi makro ile yapmak istiyorum.
Yani ilk harfin büyük harfle yazılması gereken kurallara göre hücreden çıktığımda otomatik olarak büyük harf yapmasını istiyorum.

Yazım.Düzeni formülü ile yaptığımda cümledeki bütün kelimelerin baş harflerini büyük harf yapıyor.

https://www.excel.web.tr/threads/sadece-cuemlenin-ilk-harfini-bueyuek-yapmak-nasil.117319/
Yukarıdaki linkte böyle bir konu işlenmiş ancak yarım kalmış galiba, linkte verilen formüllerden
=BÜYÜKHARF(PARÇAAL($A1;1;1))&KÜÇÜKHARF(PARÇAAL($A1;2;UZUNLUK($A1)-1)) bu formül cümle içerisindeki nokta işaretini, soru işareti ve ünlem işaretini dikkate almıyor.

=YERİNEKOY(YERİNEKOY(YAZIM.DÜZENİ(YERİNEKOY(YERİNEKOY(KÜÇÜKHARF(A1);". ";"9z9");" ";"zxz"));"9Z9";". ");"zxz";" ") bu formülde fazladan verilen boşluk olursa, soru işareti olursa, ünlem işareti olursa ve rakam olursa cümlenin baş harfini Zxz yapıyor.
İstediğim bir sonuca ulaşamadım.

Yardımcı olur musunuz?

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kod'u bir deneyin bakalım. H7'deki metnin düzeltilmiş hali I7 hücresine yazılır.

Sub BARAN()
cumle = UCase(Mid(Replace([H7], "  ", " "), 1, 1)) & Mid(Replace([H7], "  ", " "), 2, Len(Replace([H7], "  ", " ")) - 1)
    For k = 3 To Len(cumle) - 1
        If Mid(cumle, k, 1) = "." Or Mid(cumle, k, 1) = "!" Or Mid(cumle, k, 1) = "?" Then
            cumle = Left(cumle, k) & " " & UCase(Mid(cumle, k + 2, 1)) & Mid(cumle, k + 3, Len(cumle))
        End If
    Next
[I7] = Replace(cumle, "  ", " ")
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, ilginiz için çok teşekkür ediyorum.

Sadece cümlenin ilk harfini büyük yazıyor, diğer noktalama işaretlerinden sonrasındaki kelimeleri büyük yazmıyor.

 

[Ömer BARAN]

Sayfayı yenileyerek önceki cevabıma tekrar bakınız.

 

[ASLAN7410]

Sayın Ömer Bey, ellerinize sağlık çok güzel çalışıyor, çok teşekkür ediyorum, şimdi bu kodu sayfaya uygulamak gerekiyor ama yapamadım.

Yardımcı olur musunuz?

 

[Ömer BARAN]

Örnek belgeyi güncellerseniz (gerçek belgenizle aynı yapıda olsun) bakayım.
Mevcut kod, For each hücre... veya veriler belli sütunda/sütunlarda, belli satır/satırlarda ise For satir=1 To .... For sutun = 2 To... gibi döngü oluşturarak düzenlenebilir.

 

[ASLAN7410]

Sayın Ömer Bey, göndermiş olduğum örnek belge, kendimin orijinal belge ile aynı hücrelerde bulunuyor.

 

[Ömer BARAN]

Örnek belgede tek bir hücrede cümle grubu var ve mevcut kod da bu işlemi yapıyor zaten.
İsteğiniz bu işlemin yerinde (aynı hücrede) gerçekleşmesi ise kod'un sonundaki [I7]=... kısmını [H7]=... olarak değiştirin.

 

[ASLAN7410]

Sayın Ömer Bey, aşağıdaki sayfa kodu arasına sizin gönderdiğiniz kodu nasıl eklemem gerekiyor?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H7:H100")) Is Nothing Then

End If
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, dediğiniz gibi yaptım, ancak sadece bir hücrede işlem yapmış oluyor.
Diğer hücrelerde de bu işlemin olması gerekiyor.

Ayrıca aşağıdaki gibi yapınca microsoft işlemi durdurdu diye uyarı mesajı verip excel kilitlendi.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H7:H100")) Is Nothing Then

Call BARAN

End If
End Sub

 

[Ömer BARAN]

Geç oldu, yarın baksam iyi olur. Başkası cevap yazmazsa yarın cevaplandırırım.
Döngü oluştuğu için excel görevi sonlandırır veya kilitlenir normaldir.
Yeni metin hücreye yazıldığında yeni değer için kod tekrar tetikleniyor.
Bu iz varsa da kod'un durması gerekiyor.

 

[ASLAN7410]

Tamam sayın Ömer Bey, hayırlı geceler diliyorum.

 

[çıtır]

Sayın Ömer BARAN Üstadımın müsadesiyle
Farklı bir bakışla.Aşağıdaki kodu yazdım.H7 hücresinden aşağı doğru çalışır.Biraz uzun oldu gibi geldi.Daha kısa yazılabilir diye düşünüyorum.

Sub BBUYUK()

Dim s1 As Worksheet
Dim i As Integer: Dim y As Integer
Set s1 = Sheets("Sayfa1")
say = s1.Cells(65336, "H").End(3).Row
tm = s1.Range("I7:I" & say).ClearContents

For i = 7 To say
Var = Replace(Replace(Replace(Replace(Replace(Replace(s1.Range("H" & i), ".", "|"), "!", "|"), "?", "|"), ":", "|"), ";", "|"), "...", "|")
son = Len(Range("H" & i)) - Len(WorksheetFunction.Substitute(Var, "|", ""))
BH = Split(Var, "|")
For y = 1 To son
aranan = WorksheetFunction.Search(" ", BH(y - 1), 3)
uz = WorksheetFunction.Trim(Len(BH(y - 1)) + 1)
a = WorksheetFunction.Proper(Mid(BH(y - 1), 1, aranan)) & Mid(BH(y - 1), aranan, uz - aranan)
ek = Len(a) + Len(Cells(i, 9)) - y + 1
iş = Mid(s1.Cells(i, 8), ek, 1)
s1.Cells(i, 9) = s1.Cells(i, 9) & a & iş
Next y
Next i
End Sub

 

[ASLAN7410]

Sayın Çıtır Bey, ilginiz için çok teşekkür ederim. Kod gayet güzel çalışıyor ellerinize sağlık.

Göndermiş olduğunuz kodu aşağıdaki gibi sayfanın kod bölümüne ekledim güzel çalışıyor, ancak benim şablonum H sütununda bitiyor, işlem H sütunundaki hücrelerden enter ile çıktığımda kodun çalışması gerekiyor. Bu şekilde düzenleyebilir misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H7:H100")) Is Nothing Then
BBUYUK
End If
End Sub

 

[çıtır]

Baştaki sayfa tanımını ,makro başlığını ve s1. silip kopyalayın sona end if yazmayın.Yalnız kodda bir hata tespit ettim. İki nokta ve üçnokta peşpeşe olursa hata veriyor.Bilginize

 

[ASLAN7410]

Sayın çıtır, dediğinizi inanın yapamadım.

 

[ASLAN7410]

Dediğiniz gibi yapmaya çalıştım aşağıdaki kodu sayfanın kod bölümüne ekleyince, h sütunundaki hücrelerde değişiklik yaptığımda excel kilitlendi.

Private Sub Worksheet_Change(ByVal Target As Range)
say = Cells(65336, "H").End(3).Row
tm = Range("I7:I" & say).ClearContents

For i = 7 To say
Var = Replace(Replace(Replace(Replace(Replace(Replace(Range("H" & i), ".", "|"), "!", "|"), "?", "|"), ":", "|"), ";", "|"), "...", "|")
son = Len(Range("H" & i)) - Len(WorksheetFunction.Substitute(Var, "|", ""))
BH = Split(Var, "|")
For y = 1 To son
aranan = WorksheetFunction.Search(" ", BH(y - 1), 3)
uz = WorksheetFunction.Trim(Len(BH(y - 1)) + 1)
a = WorksheetFunction.Proper(Mid(BH(y - 1), 1, aranan)) & Mid(BH(y - 1), aranan, uz - aranan)
ek = Len(a) + Len(Cells(i, 9)) - y + 1
iş = Mid(Cells(i, 8), ek, 1)
Cells(i, 9) = Cells(i, 9) & a & iş
Next y
Next i
End Sub

 

[ASLAN7410]

Her halde boşa çabalıyorum galiba, benim istediğim gibi bir şey yok.

Herkesin ilgisine teşekkür ediyorum.

 

[Haluk]

Çok detaylı inceleyemedim ama, RegExp metodu ile yapılan aşağıdaki alternatifi deneyebilirsiniz ....

Bu kodla; cümlelerin nokta, soru işareti ve ünlem işareti ile bitmesi halinde, takip eden cümlenin ilk kelimesinin birinci harfi büyük harfe çevrilir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RegExp As Object, myData As Object
    If Not Intersect(Target, Range("H7:H100")) Is Nothing Then
        myStr = WorksheetFunction.Trim(LCase(Target.Text))
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.Pattern = "[.?!]\s."
        RegExp.Global = True
        For Each myData In RegExp.Execute(myStr)
            myStr = Application.Replace(myStr, myData.firstIndex + 1, myData.Length, UCase(myData.Value))
        Next
        If myStr = "" Then Exit Sub
        Target = Application.Replace(myStr, 1, 1, UCase(Left(myStr, 1)))
        Set RegExp = Nothing
    End If
End Sub

 

[Haluk]

Yukarıda 19 No'lu mesajımdaki kodda ufak bir değişiklik yaptım ....

Bilginize,

.