Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Excel'e Yeni Başlayanlar (http://www.excel.web.tr/forumdisplay.php?f=14)
-   -   Büyük harfe çevirme (http://www.excel.web.tr/showthread.php?t=169423)

ecem1989 01-01-2018 20:59

Büyük harfe çevirme
 
Arkadaşlar selam.
Çalışma sayfasındaki E2:I1000 hücreleri arasına veri girip enter tuşuna bastığımda verileni BÜYÜK HARFE dönüşmesini nasıl sağlayabilirim?
Şimdiden teşekkürler.

Ömer BARAN 01-01-2018 21:22

Merhaba.

Alt taraftan uygulama istediğiniz sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın.

NOT: Belgenizi kapatırken MAKRO İÇERİR olacak şekilde kaydetmeyi unutmayın.

İLAVE AÇIKLAMA: Aşağıdaki kod'da Sayın ASLAN'ın sorusu ile Sayın antonio ve YUSUF Bey'in farkettiği -- iı / İI -- durumu için düzeltme yapıldı.
.
Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:E10000, G2:G10000, L2:L10000]) Is Nothing Then Exit Sub
If Target <> UCase(Replace(Replace(Target, "i", "İ"), "ı", "I")) Then _
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
End Sub


YUSUF44 01-01-2018 21:22

Aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp Kod Görüntüle deyince açılan sayfaya) yapıştırıp deneyin:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:I1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Application.EnableEvents = False
Target = UCase(WorksheetFunction.Substitute(WorksheetFunction.Substitute(Target, "i", "İ"), "ı", "I"))
Application.EnableEvents = True
End Sub


asri 01-01-2018 21:26

Alternatif;

Türkçe karakter desteği bakımından @Ömer Baran ın kodlarına ekleme, @yusuf44 den de alıntı yapıldı. :)

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:I1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Target <> buyukharf(Target) Then Target = buyukharf(Target)
End Sub

Public Function buyukharf(cumle)
gecici = ""
For i11 = 1 To Len(cumle)
          h = Mid(cumle, i11, 1)
          Select Case h
            Case "ğ": gecici = gecici + "Ğ"
            Case "ü": gecici = gecici + "Ü"
            Case "ş": gecici = gecici + "Ş"
            Case "ç": gecici = gecici + "Ç"
            Case "ö": gecici = gecici + "Ö"
            Case "ı": gecici = gecici + "I"
            Case "i": gecici = gecici + "İ"
            Case Else: gecici = gecici + UCase(h)
            End Select
Next i11
buyukharf = gecici
End Function


ecem1989 01-01-2018 21:32

Çok teşekkür ederim.

ASLAN7410 01-01-2018 21:41

Sayın Ömer Bey, böyle bir koda benim de ihtiyacım var.
Sizin kodlarınız daha sade geldi, kodları aşağıdaki gibi yaptığımda çalışmıyor.

Yardımcı olur musunuz?

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:E10000], [G2:G10000], [L2:L10000]) Is Nothing Then Exit Sub
If Target <> UCase(Target) Then Target = UCase(Target)
End Sub


Haluk 01-01-2018 21:53

Eskilerden bir mesaj için aşağıdaki linke bakabilirsiniz;

http://www.excel.web.tr/f133/hucrele...ary-t7611.html

.

antonio 01-01-2018 21:59

Alternatif bile değil ama çeşit olsun :))
Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deg As String, b_harf As String
If Not Intersect(Target, [E2:I1000]) Is Nothing Then
    Application.EnableEvents = False
        deg = Target.Value
        b_harf = UCase(Replace(Replace(deg, "i", "İ"), "ı", "I"))
    Application.EnableEvents = True
    Target.Value = b_harf
End If
End Sub


Orion1 01-01-2018 22:07

Alıntı:

antonio tarafından gönderildi (Mesaj 924115)
Alternatif bile değil ama çeşit olsun :))
Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deg As String, b_harf As String
If Not Intersect(Target, [E2:I1000]) Is Nothing Then
    Application.EnableEvents = False
        deg = Target.Value
        b_harf = UCase(Replace(Replace(deg, "i", "İ"), "ı", "I"))
    Application.EnableEvents = True
    Target.Value = b_harf
End If
End Sub


Son noktayı koymuşsun.:D

ecem1989 01-01-2018 22:13

Hepinizin ilgi ve emeğine teşekkür ederim arkadaşlar.


Saat 05:56

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.