Verileri yazım düzenine sokma

[istanbulcahan]

Adı: Büyük Soyadını: Tüm harfler: Büyük yapma, ve diğer.
Örnek dosya ektedir.

 

[Necdet]

Merhaba,

Aşağıdaki kodları inceleyiniz.

Function KBY(Sozcuk As String, Tur As String)
    'Tur :  K = Küçük Harf
    '       B = Büyük Harf
    '       Y = Yazım Düzeni
    
    Sozcuk = Application.WorksheetFunction.Trim(Sozcuk)
    Tur = UCase(Tur)
    
    If Tur = "K" Then
        KBY = Evaluate("=LOWER(" & """" & Sozcuk & """" & ")")
    ElseIf Tur = "B" Then
        KBY = Evaluate("=UPPER(" & """" & Sozcuk & """" & ")")
    Else
        KBY = Evaluate("=PROPER(" & """" & Sozcuk & """" & ")")
    End If
    
End Function

Sub Duzenle()
    Dim i       As Long, _
        SonSat  As Long, _
        j       As Integer, _
        k       As Integer, _
        Sozcuk  As String, _
        Adlar   As String, _
        p1, _
        p2, _
        wf      As WorksheetFunction
        
    Set wf = Application.WorksheetFunction
        
    Application.ScreenUpdating = False
    
    SonSat = Cells(Rows.Count, "A").End(3).Row
    Range("E2:F" & SonSat).ClearContents
    
    For i = 2 To SonSat
        
        p1 = Split(Cells(i, "D"), "-")
        Adlar = ""
        
        For j = 0 To UBound(p1)
            
            p2 = Split(wf.Trim(p1(j)), " ")
            
            For k = 0 To UBound(p2)
                Sozcuk = p2(k)
                If k = UBound(p2) Then
                    p2(k) = KBY(Sozcuk, "b")
                    Adlar = Adlar & " " & p2(k) & " - "
                Else
                    p2(k) = KBY(Sozcuk, "y")
                    Adlar = wf.Trim(Adlar & " " & p2(k))
                End If
            Next k
                        
            If j = 1 Then
                Adlar = Left(Adlar, Len(Adlar) - 3)
                Adlar = Adlar & "|"
            ElseIf j = 3 Then
                Adlar = Left(Adlar, Len(Adlar) - 3)
            End If
            
        Next j
        
       Cells(i, "E") = Split(Adlar, "|")(0)
       Cells(i, "F") = Split(Adlar, "|")(1)
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır....", vbInformation, "N. YEŞERTENER ---> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

 

[istanbulcahan]

Çok güzel olmuş, ben bunu unutmuştum. Emeğine sağlık.