Karakter Sayısını okuturken 12 sabitlemek

[aksoy53]

Kullandığımız bir kitap otomasyon sisteminde barkod 12 karakter çıkarıyor fakat okuturken 13 karakter okutuyor 12 karakter görünen barkodu barkod okuyucu ile excelde oluturken 12 karakter okutacak bunun için bir kod yazarmısınız

 

[askm]

Kodları aşağıdaki ile değiştirip deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim S1 As Worksheet: Set S1 = Sheets("KİTABIN ADI")
    
    If Intersect(Target, [A2:A1500]) Is Nothing Then Exit Sub
    Aranan = Target
    If Len(Aranan) > 12 Then Target.Value = Format(Mid(Aranan, 1, 12), "@")
    
    If WorksheetFunction.CountIf(S1.Range("A:A"), Aranan) = 0 Then
        Target.Offset(0, 0).Select
        MsgBox "Listede Yok...", vbCritical
        Exit Sub
    End If
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        If CStr(Aranan) = S1.Cells(i, "A") Then
            Target.Offset(0, 1) = S1.Cells(i, "B")
            Target.Offset(0, 2) = S1.Cells(i, "C")
            Target.Offset(0, 3) = S1.Cells(i, "D")
            Target.Offset(0, 4) = S1.Cells(i, "E")
            Exit For
        End If
    Next i

End Sub

 

[aksoy53]

Çok teşekkür ederim. fakat barkod okut sayfasında okuttuğumda kitabı buluyor 12 karakter indirdi ama bu listede yok ibaresi çıkıyor ve okuttuğunda alt hücreye geçmesi gerekirken seri şekilde okutulacak her seferinde tıklamak gerekiyor bu sorun kaldırılamazmı

 

[askm]

MsgBox "Listede Yok...", vbCritical satırının başına tek tırnak (') ekleyip deneyin.

 

[aksoy53]

Hocam sonsuz teşekkür ederim tamam düzeldi fakat A1 barkodu okttummu A2 hücresine geçmesi gerekirken A1 'de kalıyor buda zaman kaybı oluyor her seferinde enter lemek bunun için bir ekleme yapabilirmiyiz.

 

[askm]

Aşağıdaki şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim S1 As Worksheet: Set S1 = Sheets("KİTABIN ADI")
    
    If Intersect(Target, [A2:A1500]) Is Nothing Then Exit Sub
    Aranan = Target
    If Len(Aranan) > 12 Then Target.Value = Format(Mid(Aranan, 1, 12), "@")
    
    If WorksheetFunction.CountIf(S1.Range("A:A"), Aranan) = 0 Then
        Target.Offset(0, 0).Select
        MsgBox "Listede Yok...", vbCritical
        Cells(Target.row+1,1).Select
        Exit Sub
     
    End If
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        If CStr(Aranan) = S1.Cells(i, "A") Then
            Target.Offset(0, 1) = S1.Cells(i, "B")
            Target.Offset(0, 2) = S1.Cells(i, "C")
            Target.Offset(0, 3) = S1.Cells(i, "D")
            Target.Offset(0, 4) = S1.Cells(i, "E")
            Exit For
        End If
    Next i
Cells(Target.row+1,1).Select
End Sub

 

[aksoy53]

Emeğine sağlık çok teşekkür ederim

 

[askm]

Rica ederim. Kolay gelsin.