Büyük Harf Makrosu

[iplikci_80]

Arkadaşlar EK'teki çalışmada, yapmak istediğim şey mevcut kodlara dokumadan hücrelere girdiğim tüm verilerin küçük harfle dahi olsa büyük harfli olmasını sağlamak istiyorum. Bu hususta yardımlarınıza ihtiyacım var.

 

[Asri]

Küçük , büyük harf ve daha bir çok işlem için aşağıdaki linki inceleyiniz.

Excel Özel İşlemler Eklentisi

http://www.excel.web.tr/f52/excel-zel-lemler-menusu-eklentisi-sao-tu-t157219.html

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Static a As Integer
Application.ScreenUpdating = False
[COLOR="Red"]Target = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))
[/COLOR]If Not Intersect(Target, Range("T:T")) Is Nothing And Target.Cells.Count = 1 Then
    Dim değer(6)
    If Len(Target) = 26 And Left(Target, 2) = "TR" Then
        For a = 1 To 26 Step 4
            değer(b) = Mid(Target, a, 4)
            b = b + 1
        Next
        Target = Join(değer, " ")
    End If
End If
If Target.Column = 2 Then
    bBuYuk = WorksheetFunction.Max(Columns(1))
    bBuyuk2 = WorksheetFunction.Max(Sheets(2).Columns(1))
    If bBuyuk2 > bBuYuk Then bBuYuk = bBuyuk2
    bBuYuk = bBuYuk + 1
Target.Offset(0, -1) = bBuYuk

End If
If (Intersect(Target, Range("F5:F5536")) Is Nothing) Or Hedef_Satir = Target.Row Then
    Hedef_Satir = 0
    Exit Sub
End If

Hedef_Satir = Target.Row
Kayit_Sil (Hedef_Satir)
Application.ScreenUpdating = True
End Sub

 

[iplikci_80]

Korhan Bey ilginize çok teşekkür ederim. Çok yavaş çalışmaya başladı bu hususta yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

Benim yaptığım eklemeden sonra mı kodlarınızın çalışması yavaşladı.

 

[iplikci_80]

Evet. Birde çalışmanın M ve T hücreleri rakamlardan oluşuyor ve düzenleri bozuluyor.

 

[askm]

Aşağıdaki gibi deneyin. or lu kısmı siz geliştirirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Static a As Integer
Application.ScreenUpdating = False
     
If Not Intersect(Target, Range("T:T")) Is Nothing And Target.Cells.Count = 1 Then
    Dim değer(6)
    If Len(Target) = 26 And Left(Target, 2) = "TR" Then
        For a = 1 To 26 Step 4
            değer(b) = Mid(Target, a, 4)
            b = b + 1
        Next
        Target = Join(değer, " ")
    End If
End If
If Target.Column = 2 Then
[color=#BF0000]
Target = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))
[/color]
    bBuYuk = WorksheetFunction.Max(Columns(1))
    bBuyuk2 = WorksheetFunction.Max(Sheets(2).Columns(1))
    If bBuyuk2 > bBuYuk Then bBuYuk = bBuyuk2
    bBuYuk = bBuYuk + 1
Target.Offset(0, -1) = bBuYuk

[color=#BF0000]
ElseIf Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11 Or Target.Column = 12 Then
Target = UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))
[/color]

End If
If (Intersect(Target, Range("F5:F5536")) Is Nothing) Or Hedef_Satir = Target.Row Then
    Hedef_Satir = 0
    Exit Sub
End If

Hedef_Satir = Target.Row
Kayit_Sil (Hedef_Satir)
Application.ScreenUpdating = True

End Sub

 

[iplikci_80]

Sayın askm ve Korhan bey ilginiz için çok teşekkür ederim. Ama önceki kodlar bozulmuş sanırım. A sütununa sicil numarası veren kısım bozulmuş sanırım.