Barkod sistemi ile otomatik parçalaal?

[korkmazes]

Merhaba Arkadaşlar,

Günlerdir barkod sistemi üzerine uğraşıyorum. Bununla ilgili excel oluşturdum fakat ürünlerin barkodunu okurken gereksiz karakterleri
Parçala_al fonksiyonu ile siliyorum. Yapmak istediğim ise VBA ile Otomatik olarak A1'den A500'e kadar olarak satırlara girilen
değerleri otomatik olarak paraçalayıp almasını istiyorum. Yani barkod cihazı ile ürünleri okuttuğum zaman otomatik olarak ürünün
seri numarasını parçalayıp alması.

Yardımlarınızı bekliyorum.

 

[veyselemre]

Sayfanın kod bölümüne ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("a1:a500"), Target) Is Nothing Then
        vl = Target.Value
        If Len(vl) = 13 And IsNumeric(vl) Then
             Target = Mid(vl, 5, 4)
            'Target = Parçala_al(vl)
        End If
    End If
End Sub

 

[korkmazes]

Cevabınız için çok teşekkürler Üstadım. Barkodu ürüne okutunca çıkan sonuç;
2171ç20002315ş15423587ş15954212ş180618ş1405

Benim arasından almak istediğim ise bu 15954212.

Sayfanın kod bölümüne ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("a1:a500"), Target) Is Nothing Then
        vl = Target.Value
        If Len(vl) = 13 And IsNumeric(vl) Then
             Target = Mid(vl, 5, 4)
            'Target = Parçala_al(vl)
        End If
    End If
End Sub

 

[Ömer BARAN]

Merhaba. İyi yıllar dilerim.
Sayın @veyselemre şu an çevrimiçi değil.

Barkod okutma yoluyla elde edilen sonuç veriye birkaç örnek vermeniz (kopyala yapıştır yöntemiyle buraya alarak) veya
sorunuzu, gerçek belgenizin özel bilgi içermeyen bir kopyası şeklinde hazırlayacağınız örnek belge üzerinden sormanızda yarar var.

Örnek belge özellikleri ve örnek belge yükleme yöntemine ilişkin kısa açıklama cevabımın altındaki İMZA ölümünde var.
.

 

[korkmazes]

Ben de bu şekilde kod buldum. Bunu sayfanın kod kısmına yazdığımda çalışıyor. Fakat istediğim gibi değil. İstediğim karakterleri çekmiyor.
Vermiş olduğunuz kod çalışmıyor.

Barkod Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A1:A500")
   
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        kopar = Range("A1")
        kopar = Mid(kopar, 1, 31)
        Range("A1") = kopar
    End If
End Sub

 

[Ömer BARAN]

Bu şekilde, sadece kullanılan kodları vererek sonuca ulaşmanız güç.
Bir önceki cevabımı tekrar okuyunuz.

 

[veyselemre]

Cevabınız için çok teşekkürler Üstadım. Barkodu ürüne okutunca çıkan sonuç;
2171ç20002315ş15423587ş15954212ş180618ş1405

Benim arasından almak istediğim ise bu 15954212.

Benim sizin ne almak istediğinizi bilmeme imkan var mı?
Ben deneme amaçlı Mid fonksiyonuyla deneme yaptım,

    Target = Mid(vl, 5, 4)

5nci sayıdan itibaren 4 karekter alacak şekilde. Bu satırı silmeniz gerekir.
Parçala_al diye bir fonksiyonunuz olduğunuzu yazmışsınız. tahmin ediyorum, bunun için,
Alttaki Tek tırnağı kaldırıp

Target = Parçala_al(vl)

satırını aktif etmeniz gerekirdi.

 

[korkmazes]

Bu şekilde, sadece kullanılan kodları vererek sonuca ulaşmanız güç.
Bir önceki cevabımı tekrar okuyunuz.

Dediğiniz gibi bağlantıyı ekledim.

Dosya Burada

Yanlış bir şey mi yaptım?

 

[Ömer BARAN]

Merhaba. Yanlış bir şey yok Sayın @korkmazes.
Ama sanırım bir iletişim sorunu var.

Konu açılış mesajında sadece çok anlaşılmayan açıklama var, örnek veri yok, kod yok.
3 numaralı cevapta sadece 1 adet örnek veri ve Sayın @veyselemre 'nin verdiği kod var.
Diğerlerinde ise içerisinde kod ve örnek veri olmayan, Veriler tablosundan PARÇAAL işleviyle 24'üncüden itibaren 8 karakteri alan formül var.
Bu formül de 3 numaralı cevaptaki örnek veriye göre istenilen sonucu vermesi gerekir gibi görünüyor.

Neticede şahsen mevcut durumu/isteği tam olarak anladığımı söyleyemiyorum.
Formül ile elde ettiğiniz sonucu makro ile almak istiyorsanız; ilgili kod'u aşağıdaki gibi değiştirmeniz yeterli olur.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A1:J500")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    Sheets("Tablo").Cells(Target.Row, Target.Column + 1) = Mid(Target.Value, 24, 8)
End If
End Sub

 

[korkmazes]

Haklısınız. Benim konunun en başın da yazdığım gibi. Paylaştığım dosyada Veriler sayfasını silip sadece tablo sayfasında A3:A500 arası parçaal komutunu otomatik yapmak istiyorum.

Barkod cihazına ürünleri okuttuğum da 2171ç20002315ş15423587ş15954212ş180618ş1405 bunu yazıyor. VBA ise bunu otomatik olarak parçaal ile arasından sadece 15954212 bunu almasını yapmak istiyorum. Detaylıca açıklayıcı olduğumu sanıyorum. Şimdiden teşekkürler.

Merhaba. Yanlış bir şey yok Sayın @korkmazes.
Ama sanırım bir iletişim sorunu var.

Konu açılış mesajında sadece çok anlaşılmayan açıklama var, örnek veri yok, kod yok.
3 numaralı cevapta sadece 1 adet örnek veri ve Sayın @veyselemre 'nin verdiği kod var.
Diğerlerinde ise içerisinde kod ve örnek veri olmayan, Veriler tablosundan PARÇAAL işleviyle 24'üncüden itibaren 8 karakteri alan formül var.
Bu formül de 3 numaralı cevaptaki örnek veriye göre istenilen sonucu vermesi gerekir gibi görünüyor.

Neticede şahsen mevcut durumu/isteği tam olarak anladığımı söyleyemiyorum.
Formül ile elde ettiğiniz sonucu makro ile almak istiyorsanız; ilgili kod'u aşağıdaki gibi değiştirmeniz yeterli olur.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A1:J500")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    Sheets("Tablo").Cells(Target.Row, Target.Column + 1) = Mid(Target.Value, 24, 8)
End If
End Sub

 

[korkmazes]

Kusura bakmayın lütfen. Vermiş olduğunuz kodlar başarılı bir şekilde çalıştı.

Fakat B Hücresinde kilerinin tamamının A Hücresin de yazdırmak istiyorum. Barkoddan yazdırdığım gibi direk A Hücresine yazmam lazım.

Merhaba. Yanlış bir şey yok Sayın @korkmazes.
Ama sanırım bir iletişim sorunu var.

Konu açılış mesajında sadece çok anlaşılmayan açıklama var, örnek veri yok, kod yok.
3 numaralı cevapta sadece 1 adet örnek veri ve Sayın @veyselemre 'nin verdiği kod var.
Diğerlerinde ise içerisinde kod ve örnek veri olmayan, Veriler tablosundan PARÇAAL işleviyle 24'üncüden itibaren 8 karakteri alan formül var.
Bu formül de 3 numaralı cevaptaki örnek veriye göre istenilen sonucu vermesi gerekir gibi görünüyor.

Neticede şahsen mevcut durumu/isteği tam olarak anladığımı söyleyemiyorum.
Formül ile elde ettiğiniz sonucu makro ile almak istiyorsanız; ilgili kod'u aşağıdaki gibi değiştirmeniz yeterli olur.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A1:J500")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    Sheets("Tablo").Cells(Target.Row, Target.Column + 1) = Mid(Target.Value, 24, 8)
End If
End Sub

 

[veyselemre]

Barkod cihazına ürünleri okuttuğum da 2171ç20002315ş15423587ş15954212ş180618ş1405 bunu yazıyor. VBA ise bunu otomatik olarak parçaal ile arasından sadece 15954212 bunu almasını yapmak istiyorum. Detaylıca açıklayıcı olduğumu sanıyorum. Şimdiden teşekkürler.

Kodu aşağıdaki gibi deneyiniz, barkod uzunluğu 43 den farklıysa yine çalışmaz.
barkodlar 43den farklı olabiliyorsa yıldızlı satırları silin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("a1:a500"), Target) Is Nothing Then
        vl = Target.Value
        If Len(vl) = 43 Then '**
             Target = Mid(vl, 24, 8)
        End If '**
    End If
End Sub

 

[korkmazes]

Yardımlarınız için çok teşekkürler kod çalıştı.

Kodu aşağıdaki gibi deneyiniz, barkod uzunluğu 43 den farklıysa yine çalışmaz.
barkodlar 43den farklı olabiliyorsa yıldızlı satırları silin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("a1:a500"), Target) Is Nothing Then
        vl = Target.Value
        If Len(vl) = 43 Then '**
             Target = Mid(vl, 24, 8)
        End If '**
    End If
End Sub