Alt alta benzer karakterler gelince hata

[editedbycenk]

Merhaba

27…..
P0….
27….
P0….

Şeklinde a hücresinde aşağı doğru gidecek şekilde barkod ve referans numaraları okutuyoruz ancak her 2 ile başlayanın altına P ile başlayan gelmek zorunda yani 2 ile başlayanın altına 2 gelirse veya p ile başlayanın altına p gelirse hata textbox ı çıkacak şekilde makro nasıl yazarız

 

[ÖmerFaruk]

Öncelikle sorunuzu tekrar okudum.
Şeklinde A sütununda aşağı doğru gidecek şekilde barkod ve referans numaraları okutuyoruz. Ancak her 2 ile başlayanın altına P ile başlayan gelmek zorunda. Yani 2 ile başlayanın altına 2 gelirse veya p ile başlayanın altına p gelirse hata textbox ı çıkacak şekilde makro nasıl yazarız?

Aşağıdaki kodları deneyin lütfen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SonHücre As Range
Set SonHücre = Range("A" & Rows.Count).End(3)
If Left(SonHücre.Offset(0, 0), 1) = Left(SonHücre.Offset(-1, 0), 1) Then
    MsgBox "Bir Önceki de " & Left(SonHücre.Offset(0, 0), 1) & " ile başlıyor"
    Set SonHücre = Nothing
End If
End Sub

 

[editedbycenk]

Run time error 1004

Application defined or object defined error

hatası alıyorum ve

İf left ile başlayan satır sarı gözüküyor

 

[editedbycenk]

SonHücre.Offset(-1,0) bu kodda patlıyor A1 satırı en üst olduğu için bir üst satırı yok buna nasıl bir çözüm bulabiliriz ilk satır için

 

[AdemCan]

Merhaba, Sayın ÖmerFaruk'un paylaştığı kodları aşağıdaki şekilde kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row > 1 Then
ust_hucre = Target.Offset(-1, 0).Value
hucre = Target.Value
    If Left(hucre, 1) = Left(ust_hucre, 1) Then
        MsgBox "Bir Önceki de " & Left(hucre, 1) & " ile başlıyor"
        Target.Value = ""
        Exit Sub
    End If
End If
End Sub

 

[editedbycenk]

Merhaba, Sayın ÖmerFaruk'un paylaştığı kodları aşağıdaki şekilde kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row > 1 Then
ust_hucre = Target.Offset(-1, 0).Value
hucre = Target.Value
    If Left(hucre, 1) = Left(ust_hucre, 1) Then
        MsgBox "Bir Önceki de " & Left(hucre, 1) & " ile başlıyor"
        Target.Value = ""
        Exit Sub
    End If
End If
End Sub

Merhaba şimdide alt alta 2 boşluk geldiği zaman msgbox açık kalıyor ve kapatmaya çalıştığımda gitmiyor sürekli geliyor

 

[AdemCan]

Örnek paylaşır mısınız?

 

[ÖmerFaruk]

Siz sanırım 1. satıra da veri yazıyorsunuz. Genelde 1..satır başlık olarak düşünüldüğü için bir şey yapmamıştım.
Aşağıdaki gibi deneyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim SonHücre As Range
    Set SonHücre = Range("A" & Rows.Count).End(3)
    If SonHücre.Row = 1 Then GoTo Son
    If Left(SonHücre.Offset(0, 0), 1) = Left(SonHücre.Offset(-1, 0), 1) Then
        MsgBox "Bir Önceki de " & Left(SonHücre.Offset(0, 0), 1) & " ile başlıyor"
    End If
Son:
    Set SonHücre = Nothing
End Sub

 

[editedbycenk]

Siz sanırım 1. satıra da veri yazıyorsunuz. Genelde 1..satır başlık olarak düşünüldüğü için bir şey yapmamıştım.
Aşağıdaki gibi deneyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim SonHücre As Range
    Set SonHücre = Range("A" & Rows.Count).End(3)
    If SonHücre.Row = 1 Then GoTo Son
    If Left(SonHücre.Offset(0, 0), 1) = Left(SonHücre.Offset(-1, 0), 1) Then
        MsgBox "Bir Önceki de " & Left(SonHücre.Offset(0, 0), 1) & " ile başlıyor"
    End If
Son:
    Set SonHücre = Nothing
End Sub

Hocam çok teşekkür ederim bir sorum daha olacak yine vba ortamında alt alta p veya alt alta 2 ile başlayan gelince kırmızıya boyayacak diğerleri yeşil olacak şekilde yapabilirizmiyiz ? Hata msgbox ı değilde alt alta gelenleri kırmızıya boyasın

 

[ÖmerFaruk]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim SonHücre As Range
    Set SonHücre = Range("A" & Rows.Count).End(3)
    If SonHücre.Row = 1 Then GoTo Son
    If Left(SonHücre.Offset(0, 0), 1) = Left(SonHücre.Offset(-1, 0), 1) Then
        SonHücre.Interior.Color = vbRed
    Else
        SonHücre.Interior.Color = vbGreen
    End If
Son:
    Set SonHücre = Nothing
End Sub

 

[editedbycenk]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Dim SonHücre As Range
    Set SonHücre = Range("A" & Rows.Count).End(3)
    If SonHücre.Row = 1 Then GoTo Son
    If Left(SonHücre.Offset(0, 0), 1) = Left(SonHücre.Offset(-1, 0), 1) Then
        SonHücre.Interior.Color = vbRed
    Else
        SonHücre.Interior.Color = vbGreen
    End If
Son:
    Set SonHücre = Nothing
End Sub

Çok teşekkür ederim