büyük küçük harf yapma kodu

[hsen]

Merhaba, sitede bir kod buldum bu kod çok işime yaradı fakat bir sorunla karşılaşıyorum. tablom da kod bölümünde aşağıda da göreceğiniz üzere hem otomatik sayı artırma hem koşula bağlı otomatik tarih saat yazma ve hemde büyük harfe dönüştürme işlemini yapamıyorum. desteğe ihtiyacım var yardımcı olmanızı rica ederim. bu kodlamaya nasıl bir ekleme ile yazdığım hücrenin harfleri büyük harf olur
Bulduğum kod;
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [e:e]) Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Target.Value = BuyukHarf(Target.Value)
Application.EnableEvents = True

End Sub

Function BuyukHarf(Veri As String)

BuyukHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))

End Function


Yapmak istediğim kodlama altına nasıl ekleyebilirim ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:B5536]) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Offset(-1, -1).Value = "" Then
Target.Offset(0, -1).Value = 1
Else
Target.Offset(0, -1).Value = Target.Offset(-1, -1).Value + 1
End If
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 2
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd.mm.yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub

 

[ÖmerBey]

Merhaba,
Buna birkaç farklı çözüm üretilebilir, en basit haliyle mevcut kodunuzda kırmızı renkli düzeltmeyi uygulayabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:B5536]) Is Nothing Then GoTo 1
On Error Resume Next
If Target.Offset(-1, -1).Value = "" Then
Target.Offset(0, -1).Value = 1
Else
Target.Offset(0, -1).Value = Target.Offset(-1, -1).Value + 1
End If
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 2
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd.mm.yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If

1
If Intersect(Target, [e:e]) Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Target.Value = BuyukHarf(Target.Value)
Application.EnableEvents = True

End Sub

 

[hsen]

Ömer bey süper oldu bir kaç hata verdi ama düzeltme yaptıktan sonra süper çalışıyor eline sağlık teşekkür ederim.

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...