İki ktf yi birleştirme ben beceremedim

[hsayar]

Function NTC_Düzeni(ByVal metin As String)
On Error Resume Next
    'metin = ""
    ilkharf = ""
    dgrharf = ""
'
        metin = LCaseTr(metin)
        ilkharf = UCaseTr(Left(metin, 1))
        dgrharf = Right(metin, (Len(metin) - 1))
        NTC_Düzeni = ilkharf & dgrharf
'    Next
End Function

Function NTC2(ByVal metin As String)
On Error Resume Next
    'metin = "Hüseyin okula gitti. dersi yokmuş geri geldi."
    ilkharf = "":    dgrharf = "":    cumle = "":      SCumle = "":
    metin = Replace(metin, ". ", ".")
    a = Split(metin, ".")
        For j = UBound(a) To 0 Step -1
            cumle = [B]NTC_Düzeni(a(j))[/B]
            snc = cumle & ". " & snc
        Next j
    NTC2 = snc
End Function

beceremediğim için koyu harfli yere gönderme yapıyorum nasıl birleştiririm.

ntc2 fonksiyonu, bir hücredeki aşağıdaki şekildeki cümleleri;
hüseyin okula gitti.dersi yokmuş geri geldi. yarın yine gidecek. AMA GELİRMİ BİLMEM
yazıldığı hücrede aşağıdaki şekilde
Hüseyin okula gitti. Dersi yokmuş geri geldi. Yarın yine gidecek. Ama gelirmi bilmem.
döndürür.

 

[veyselemre]

Function NTC(metin As String)
    metin = Replace(metin, ". ", ".")
    a = Split(metin, ".")
    For x = 0 To UBound(a)
        al = Trim(a(x))
        a(x) = WorksheetFunction.Proper(Left(al, 1)) & Evaluate("=lower(" & Chr(34) & Right(al, Len(al) - 1) & Chr(34) & ")")
    Next x
    NTC = Join(a, ". ") & "."
End Function

 

[hsayar]

hocam ilginize teşekkür ederim, "." dan sonra güzel işliyor. ancak paragraf sonunda "." varsa dğer hatası veriyor bunun için hücredeki son işaret "." ise boşluğa çevirmek lazım. ben bir deneyeyim olmazsa bu konuda da yardımınızı istiyorum, Ayrıca
!, ? işaretinden sonraki durumlarda da büyük harfle başlatmak mümkün olur mu?

yani aynı paragrafta diyelim .,?,! varsada bu işaretlerden sonra gelenler büyük harfle başlasın

 

[veyselemre]

Function NTC(metin As String)

Dim oMatches As Object, i As Integer, al As String, hepsi As String

    With CreateObject("vbscript.regexp")
        .Pattern = "\.|\?|\!"
        .Global = True
        bas = 1
        Set oMatches = .Execute(metin)
        For i = 0 To oMatches.Count - 1
            uz = oMatches(i).firstindex + 2 - bas
            al = Trim(Mid(metin, bas, uz))
            bas = oMatches(i).firstindex + 2
            hepsi = hepsi & WorksheetFunction.Proper(Left(al, 1)) & Evaluate("=lower(" & Chr(34) & Right(al, Len(al) - 1) & Chr(34) & ")") & " "
        Next i
    End With

    NTC = Trim(hepsi)

End Function

Sub dene()
    MsgBox NTC("hüseyin okula gitti.dersi yokmuş geri geldi. yarın yine gidecek. Keşke gitseydi!AMA GELİRMİ BİLMEM?")
End Sub

 

[hsayar]

Hocam ilginize çok teşekkür ederim

MsgBox NTC("hüseyin okula gitti.dersi yokmuş geri geldi. yarın yine gidecek. Keşke gitseydi!AMA GELİRMİ BİLMEM")
[code]

şeklinde olunca [B]AMA GELİRMİ BİLMEM[/B] cümleyi yutuyor.....
En son Cümlenin sonunda noktalama işareti yoksa "." koysun ondan sonra işlemi yapsın mümkün mü?

 

[veyselemre]

Böyle deneyin.

Function NTC(metin As String)
    metin = Trim(metin)
    sonkar = Right(metin, 1)
    If Not (sonkar = "." Or sonkar = "?" Or sonkar = "!") Then metin = metin & "."

    Dim oMatches As Object, i As Integer, al As String, hepsi As String

    With CreateObject("vbscript.regexp")
        .Pattern = "\.|\?|\!"
        .Global = True
        bas = 1
        Set oMatches = .Execute(metin)
        For i = 0 To oMatches.Count - 1
            uz = oMatches(i).firstindex + 2 - bas
            al = Trim(Mid(metin, bas, uz))
            bas = oMatches(i).firstindex + 2
            hepsi = hepsi & WorksheetFunction.Proper(Left(al, 1)) & Evaluate("=lower(" & Chr(34) & Right(al, Len(al) - 1) & Chr(34) & ")") & " "
        Next i
    End With

    NTC = Trim(hepsi)

End Function

Sub dene()
    MsgBox NTC("hüseyin okula gitti.dersi yokmuş geri geldi. yarın yine gidecek. Keşke gitseydi!AMA GELİRMİ BİLMEM? gelmez")
End Sub

 

[hsayar]

elinize sağlık, saygılarımla.