küçük büyük harf

[ckayaz]

Sayın yeşertener'in kodunu kendi sayfama uyarlamaya çalıştım ama yapamadım yardımcı olacak arkadaşlara teşekkür ederim

F4:F1500 ve G4:G1500 arasında olan sütunlardaki verileri büyük harfe çevirmek istiyorum yalnızca F sütununda veya G sütunundakileri yapabiliyorum ama iki sütundakileri yapamadım

Option Explicit


Sub Degistir()

Dim i As Long
Dim dz1
Dim dz2
dz1 = Array("ç", "ğ", "ı", "İ", "i", "ö", "ş", "ü")
dz2 = Array("c", "g", "I", "I", "I", "o", "s", "u")

Application.ScreenUpdating = False

For i = 0 To UBound(dz1)
Columns("A:A").Replace What:=dz1(i), Replacement:=dz2(i), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Next i

For i = 1 To Cells(Rows.Count, "A").End(3).Row
Cells(i, "A") = UCase(Cells(i, "A"))
Next i

Application.ScreenUpdating = True

MsgBox "Büyük Harfe Çevrildi....", vbInformation, "N. YEŞERTENER --> www.excel.web.tr"

End Sub

 

[Necdet]

Merhaba,

O kodlar anımsadığım kadarıyla Türkçe karakterleri ingilizce karakterlerle değiştirip sonra büyük / küçük harfe çevirmek için.

Ben size genel bir fonksiyon önereyim. ister vba da isterse excelde kullanabilirsiniz.

Function BKH(Sozcuk As String, Optional Tip As Integer = 2) As String
    'Tip    1. Küçük Harf
    '       2. Büyük Harf
    '       3. Yazım Düzeni
    
    If Tip = 1 Then
        BKH = Evaluate("=LOWER(" & """" & Sozcuk & """" & ")")
    ElseIf Tip = 2 Then
        BKH = Evaluate("=UPPER(" & """" & Sozcuk & """" & ")")
    Else
        BKH = Application.WorksheetFunction.Proper(Sozcuk)
    End If
    
End Function

 

[ckayaz]

Sayın yeşertener geç cevap verdim kusura bakmayın sizin gönderdiğiniz kodlardan yola çıktım bir adım atmışken, ama son gönderdiğiniz kodla sizin yapmaya çalıştığınızla benim isteklerim uyuşmadı herhalde, veya ben beceremedim ben comand butonla ve makro düğmesi ile belirtmiş olduğum sütunda nekadar küçük harfler varsa büyük harfe çevirmek istiyorum. Bu olay sayfada formül olmaksızın butonsuz ve düğmesizde olabilir yalnızca f4:f1500 ve g4.g1500 sütunları olacak. dosyam ektedir

 

[tahsinanarat]

Belirtilen aralık için aşağıda kodu deneyin

Sub doluhucre_sec()
Dim range As range
Sheets("KAYIT").Activate
    ActiveSheet.range("F4:G1500").Select
For Each range In Selection
If range.HasFormula = False Then
   range.Value = UCase(range.Value)
End If
Next
End Sub

 

[tahsinanarat]

Hücreye girildiği anda çevrilmesini istiyorsanız,(aralığı siz kendinize göre uyarlayın)

Private Sub Worksheet_Change(ByVal Target As range)
On Error GoTo 10
If Intersect(Target, [B3:B1500]) Is Nothing Then Exit Sub
For i = 1 To Len(Target)
    x = x + Application.WorksheetFunction.Proper(Mid(Target, i, 1))
Next i
Target = x
10
End Sub

 

[Necdet]

Verdiğim kodların uygulanmasıdır.

Sub Düğme17_Tıklat()
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    For i = 1 To Cells(Rows.Count, "g").End(3).Row
        Cells(i, "g") = BKH(Cells(i, "g"), 2)
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "Büyük Harfe Çevrildi....", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

Function BKH(Sozcuk As String, Optional Tip As Integer = 2) As String
    'Tip    1. Küçük Harf
    '       2. Büyük Harf
    '       3. Yazım Düzeni
    
    If Tip = 1 Then
        BKH = Evaluate("=LOWER(" & """" & Sozcuk & """" & ")")
    ElseIf Tip = 2 Then
        BKH = Evaluate("=UPPER(" & """" & Sozcuk & """" & ")")
    Else
        BKH = Application.WorksheetFunction.Proper(Sozcuk)
    End If
    
End Function

 

[Korhan Ayhan]

Alternatif olarak aşağıdaki kodu da deneyebilirsiniz.

İlgili sayfanın kod bölümüne uygulayınız.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Kucuk_Harf As Variant, Buyuk_Harf As Variant, X As Byte
    
    On Error GoTo Son
    
    Set Alan = Range("F4:G1500")
    Kucuk_Harf = Array("a", "b", "c", "ç", "d", "e", "f", "g", "ğ", "h", "ı", "i", "j", "k", "l", "m", "n", "o", "ö", "p", "r", "s", "ş", "t", "u", "ü", "v", "y", "z", "q", "w", "x")
    Buyuk_Harf = Array("A", "B", "C", "Ç", "D", "E", "F", "G", "Ğ", "H", "I", "İ", "J", "K", "L", "M", "N", "O", "Ö", "P", "R", "S", "Ş", "T", "U", "Ü", "V", "Y", "Z", "Q", "W", "X")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For X = 0 To UBound(Kucuk_Harf)
        Alan.Replace Kucuk_Harf(X), Buyuk_Harf(X)
    Next
    
Son:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[ckayaz]

sayın Necdet Yeşertener,sayın Tahsinanarat ve sayın Korhan Aydın hepinizede ayrı ayrı teşekkür etmek istiyorum, ilgi ve alakanızdan dolayı.
Sizin sayenizde birşeyleri yeni yeni öğreniyoruz ve şunu belirtmek istiyorum sayın Yeşertener'in kodları ile yalnızca bir sütunu yapabildim, sayın Tahsinarat'ın kodları güzeldi ama izmir ili IZMIR ILI oluyor,Sayın Aydın'ın kodları ile istediğim oldu izmir İZMİR oluyor.

Bir konuyu belirtmeden geçemiycem bazen bir konu açtığım zaman cevaplar su gibi akıyor bazende yağmur duasına çıkmış gibi hissediyorum kendimi. Ama yine de ben bu forumu seviyorum sabretmeyi öğretiyor insanlara. Unutmadan modları bulmuşken dertlerimi dökmek istedim yinede teşekkürlerrrr

 

[Necdet]

Sayın Yeşertener'in kodları ile yalnızca bir sütunu yapabildim

Kullanacağınız Döngüye göre istediğiniz kadar sütunu yapabilirsiniz.

Kodları inceleyiniz. Benim verdiğim kodlar çok genel amaçlı hazırlanmış kodlardır.

ilgili Function u istediğiniz dosyaya kopyalayarak kolayca kullanabilirsiniz. her seferinde kodları yeniden yazma gereği duymazsınız.

 

[baydeniro]

sayın üstadlar çok teşekkürker.

 

[o2l3m]

Hücreye girildiği anda çevrilmesini istiyorsanız,(aralığı siz kendinize göre uyarlayın)

Private Sub Worksheet_Change(ByVal Target As range)
On Error GoTo 10
If Intersect(Target, [B3:B1500]) Is Nothing Then Exit Sub
For i = 1 To Len(Target)
    x = x + Application.WorksheetFunction.Proper(Mid(Target, i, 1))
Next i
Target = x
10
End Sub

- C,G,H,J,K Sütunlarında makro çalışacak olsa
- Kelimeler arasında 1 boşluk bıraksa
- İlk harfleri büyük olsa kod nasıl olurdu acaba?

 

[o2l3m]

Yukarıdaki kodda Güncelleme yapacak yok mu?

 

[YUSUF44]

Aşağıdaki kodları deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C, G:H, J:K]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target = WorksheetFunction.Trim(WorksheetFunction.Proper(Target))
Application.EnableEvents = True
End Sub

 

[o2l3m]

Çok teşekkür ediyorum