Worksheet_Change de iki kodu çalıştırma

[YILDIZ YAĞMURU]

Alttaki iki kod Worksheet_Change de çalışmıyor . iki kodu aynı anda çalışmasını sağlabilirmiyiz acaba . Alttaki şekilde hangi kod üstteyse o çalışıyor . yardımcı olurmusunuz


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim s As Long
If Intersect(Target, Range("b5:b55")) Is Nothing Then Exit Sub
For i = 5 To Range("b55").End(3).Row
If Cells(i, 2).Value <> "" Then
s = s + 1
Cells(i, 1).Value = s
End If
Next i
If Target.Value = "" Then
Target.Offset(0, -1).ClearContents
End If


On Error Resume Next
If Intersect(Target, Range("By5:cC55,CE5:CG55")) Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Application.EnableEvents = True

End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    On Error Resume Next
    
    Dim s As Long, i As Long
    
    If Intersect(Target, Range("[COLOR=red]B5:B55,By5:cC55,CE5:CG55[/COLOR]")) Is Nothing Then Exit Sub
    
   [COLOR=red] If Target.Column = 2 Then
[/COLOR]        For i = 5 To Range("b55").End(3).Row
            If Cells(i, 2).Value <> "" Then
                s = s + 1
                Cells(i, 1).Value = s
            End If
        Next i
        
        If Target.Value = "" Then
            Target.Offset(0, -1).ClearContents
        End If
    [COLOR=red]Else[/COLOR]
        
        Application.EnableEvents = False
        Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
        Application.EnableEvents = True
[COLOR=red]    End If[/COLOR]
 
End Sub

.

 

[YILDIZ YAĞMURU]

çok teşekkürler

bilgine sağlık Ömer

 

[YILDIZ YAĞMURU]

Merhaba,

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    On Error Resume Next
    
    Dim s As Long, i As Long
    
    If Intersect(Target, Range("[COLOR=red]B5:B55,By5:cC55,CE5:CG55[/COLOR]")) Is Nothing Then Exit Sub
    
   [COLOR=red] If Target.Column = 2 Then
[/COLOR]        For i = 5 To Range("b55").End(3).Row
            If Cells(i, 2).Value <> "" Then
                s = s + 1
                Cells(i, 1).Value = s
            End If
        Next i
        
        If Target.Value = "" Then
            Target.Offset(0, -1).ClearContents
        End If
    [COLOR=red]Else[/COLOR]
        
        Application.EnableEvents = False
        Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
        Application.EnableEvents = True
[COLOR=red]    End If[/COLOR]
 
End Sub

.

Ömer bey bu düzenlediğiniz kodu sadece B sütununda çalıştırabilirmiyiz acaba .

her iki kod da B sütunuda çalışabilirmi ?

B5:B500 sütununa sıra no ver
B3:B500 sütununda küçük harfleri büyük harf yap şeklinde olabilirmi acaba rica etsem bir boş vaktinizde bakarmısınız .

 

[Ömer]

Else kelimesini silmeniz yeterli olacaktır.

 

[Korhan Ayhan]

Son istediğiniz işlemde bir sorun var. B sütununa hem sıra no verip hemde büyük harfe çevirmek istiyorsunuz? Sayılar nasıl büyük harfe çevrilecek?

 

[YILDIZ YAĞMURU]

ÇOK TEŞEKKÜRLER, Ömer bey

Else kelimesini silmeniz yeterli olacaktır.

sizlere çok teşekkür ederim arkadaşlar...