Aktif hücreyi büyük harf ile yazmak

[ASLAN7410]

Merhaba, herkese hayırlı geceler.

Ekte gönderdiğim excel dosyasında tablo yapmaya çalışıyorum, elimdeki örnek kodlarla yapmaya çalıştım, yapamadım.

Yapmak istediğim

Girdiğim veriler 3.satırdan başlıyor.
A sütununa B sütunundaki dolu hücreye göre sıra no vermek.
B sütunu, F sütunu ve H sütununda kelimeler nasıl yazılırsa yazılsın büyük harf olması.
G sütununa veri girildiğinde, cümlenin ilk harfinin büyük harf olmasını diğer harflerin küçük harfle olmasını istiyorum.

Yardımcı olur musunuz?
.

 

[ASLAN7410]

Forumda aşağıdaki kodu buldum ancak kendi sayfama uyarlıyamadım.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Son
    
    If Intersect(Target, [A:C]) Is Nothing Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Column > 3 Then Exit Sub
    
    Application.EnableEvents = False
    
    If Target.Column = 1 Then
        Target = KucukHarf(Target.Value)
    ElseIf Target.Column = 2 Then
        Target = YazimDuzeniHarf(Target.Value)
    Else
        Target = BuyukHarf(Target.Value)
    End If
    
    Application.EnableEvents = True
    
Son:
End Sub

Function BuyukHarf(Veri As String)
    BuyukHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))
End Function

Function KucukHarf(Veri As String)
    KucukHarf = LCase(Replace(Replace(Veri, "İ", "i"), "I", "ı"))
End Function

Function YazimDuzeniHarf(Veri As String)
    YazimDuzeniHarf = Application.WorksheetFunction.Proper(Veri)
End Function

 

[ASLAN7410]

Arkadaşlar G sütunu çok işlev gerektirebilir, G sütununa gerek yok o zaman.

 

[ASLAN7410]

Aşağıdaki kodu B, F ve H sütunlarına nasıl uyarlarız? Veriler 3.satırdan başlıyor.

Private Sub Worksheet_Change(ByVal Target As Range)

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

End Sub

 

[askm]

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Sut = Target.Column: Sat = Target.Row
If Sat > 2 And Sut = 2 Then
    If Cells(Sat, 2) <> "" Then
        Cells(Sat, 1) = WorksheetFunction.CountIf(Range("B3:B" & Sat), "<>")
        Exit Sub
    Else
        Cells(Sat, 1) = ""
        Exit Sub
    End If
End If
If Sat > 2 And Sut = 2 Or Sut = 6 Or Sut = 7 Then
    Cells(Sat, Sut) = UCase(Replace(Replace(Cells(Sat, Sut), "i", "İ"), "ı", "I"))
    Exit Sub
End If
Application.ScreenUpdating = True
End Sub

 

[ASLAN7410]

Sayın askm, ilginiz için çok teşekkür ediyorum.

Göndermiş olduğunuz kodu uyguladığımda, A sütununda sıra numarasını veriyor, ancak B sütununda boş veriyi atlayarak sıra numarası veriyor.

B ve H sütunundaki veriyi büyük harf yazmıyor, sadece F sütunundaki veriyi büyük harf yazıyor.

Sizin kodların yaptığı işlemin resmini ve yapmak istediğimin resmini gönderiyorum.

Bu şekilde düzeltebilir misiniz?

 

[ASLAN7410]

Sıralama kodu aşağıdaki kod güzel çalışıyor ancak bu seferde aralara numara vermiyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
Target.Offset(0, -1).Value = Target.Row - 2
End Sub

 

[askm]

Private Sub Worksheet_Change(ByVal Target As Range)
Sut = Target.Column: Sat = Target.Row
If Sat > 2 And Sut = 2 Or Sut = 6 Or Sut = 7 Then
    If Sut = 2 Then
            Cells(Sat, 1) = Sat - 2
            Cells(Sat, Sut) = UCase(Replace(Replace(Cells(Sat, Sut), "i", "İ"), "ı", "I"))
            Exit Sub
    Else
        Cells(Sat, Sut) = UCase(Replace(Replace(Cells(Sat, Sut), "i", "İ"), "ı", "I"))
        Exit Sub
    End If
End If
End Sub

 

[ASLAN7410]

Sayın askm, kod H sütununu büyük harf yapmıyor.
Ayrıca B sütununda bazı hücrelere plaka girmeyip, alt satıra plaka girdiğimde, B sütununda plaka olmayan yerlerin karşısı olan A sütununda sıra numarası yazmıyor.

 

[ASLAN7410]

Arkadaşlar uzun uğraşlar sonucu elimde bulunan kodlarla aşağıdaki gibi yaptım, güzel çalışıyor.

Ancak bir sorun var, sıra numarası verirken sadece B,F,H sütunlarına veri girildiği zaman sıra numarası veriyor.

Aşağıdaki kodların içerisindeki If Intersect(Target, Range("B:H")) Is Nothing Then Exit Sub kısmını bu şekilde yaptığım zaman, B ile H sütunu arasındaki bütün verilerin hepsini büyük harf yapıyor.

Yapmak istediğim B, F ve H sütunundaki veri girdiğimde büyük harf yapsın,
B3 ile H sütunu arasına veri girdiğimde A3 sütununda sıra numarası versin.

Aşağıdaki kodu düzenleyebilir misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ilk As String, son As String, deg As String
[B]If Intersect(Target, Range("B:B,F:F,H:H")) Is Nothing Then Exit Sub[/B]
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Column = 2 Then
    Target.Value = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
    Else
    Target.Value = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
End If
Application.EnableEvents = True


[B]If Intersect(Target, [B3:H1048576]) Is Nothing Then Exit Sub[/B]

    Eski = WorksheetFunction.Max(3, Cells(Rows.Count, "A").End(3).Row)
    b = WorksheetFunction.Max(3, Cells(Rows.Count, "B").End(3).Row)
    c = WorksheetFunction.Max(3, Cells(Rows.Count, "C").End(3).Row)
    d = WorksheetFunction.Max(3, Cells(Rows.Count, "D").End(3).Row)
    e = WorksheetFunction.Max(3, Cells(Rows.Count, "E").End(3).Row)
    F = WorksheetFunction.Max(3, Cells(Rows.Count, "F").End(3).Row)
    g = WorksheetFunction.Max(3, Cells(Rows.Count, "G").End(3).Row)
    h = WorksheetFunction.Max(3, Cells(Rows.Count, "H").End(3).Row)
    
    Range("A3:A" & Eski).ClearContents
    son = WorksheetFunction.Max(b, c, d, e, F, g, h)
    For i = 3 To son
        Cells(i, "A") = i - 1
    Next
Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    If Intersect(Target, Range("B3:H" & Rows.Count)) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Select Case Target.Column
        Case 2, 6, 8
        Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
    End Select
    Son = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("A3") = 1
    Range("A3").AutoFill Destination:=Range("A3:A" & Son), Type:=xlFillSeries
    Range("A2:H" & Son).Borders.LineStyle = 1
10  Application.EnableEvents = True
End Sub

 

[ASLAN7410]

Sayın Korhan Bey, valla süper oldu tam istediğim gibi çalışıyor, ellerinize sağlık, çok teşekkür ediyorum.

Hayırlı geceler, hayırlı çalışmalar diliyorum.