Barkod numarası ayrıştırma

Ücretli Özel Dersler Ve Özel Programlamalar İle İlgili Bölüm

Barkod numarası ayrıştırma

İleti#1)  skyeagleseo » 22 Tem 2021 19:26

Merhaba arkadaşlar, forumunuza yeni üye oldum. --)(

Gördüğüm kadarıyla alanında uzman arkadaşlar ile beraber aynı çatı altındayım.

Şimdi istediğim kısıma geleyim. Doğru izah etmek, bu işin yarısı galiba.

Şimdi biz, depoda iadeye ve garantiye gelen malları barkod okutarak excel e topluyoruz.

Sıkıntımız şu; 5 kişi aynı anda barkod okutuyor.

Barkodların başına; A,B,C,D,E Gibi harf tanımlaması yaptık.

Yani ahmet arkadaşımız barkod okutunca 123456 olarak değil, A123456 olarak yazdırıyor.

Şimdi istediğimiz kısım şu ;

excel'de A1 Kısmına tüm barkodlar karışık olarak okutulacak.

Örnek ;

Resim

barkodları okutma işi bitince, bir kısayol yada buton olabilir ona basınca şu şekilde listelemesini istiyorum.

örnek;

Resim

listeleme işini yaparken, çift veya daha fazla girilen barkod numaraların teke düşürülmesini de istiyorum

yardımcı olan arkadaşlara şimdiden teşekkür ederim, kurban bayramınızı en içten dileklerimle kutlarım.

iletişim skyeagleseo @ gmail .com
Kullanıcı avatarı
skyeagleseo
 
Kayıt: 22 Tem 2021 18:18
Meslek: ofis elemanı
Yaş: 35
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: amasya

Yıllık Maaş Bordrosu Hesaplama 2022

Cevap: Barkod numarası ayrıştırma

İleti#2)  okutkan » 23 Tem 2021 00:51

5 kişi mi barkod okutuyor? Yani a-e arasında mı barkodlar?
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

Cevap: Cevap: Barkod numarası ayrıştırma

İleti#3)  skyeagleseo » 23 Tem 2021 01:41

okutkan yazdı:5 kişi mi barkod okutuyor? Yani a-e arasında mı barkodlar?


5 kişinin okuttukları barkodlar A'da listeleniyor. sonra ben onları elle ayrıştırıyorum, bu da çok zaman kaybına neden oluyor
Kullanıcı avatarı
skyeagleseo
 
Kayıt: 22 Tem 2021 18:18
Meslek: ofis elemanı
Yaş: 35
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: amasya

Cevap: Barkod numarası ayrıştırma

İleti#4)  okutkan » 23 Tem 2021 02:02

A sütununda başında a b c d e harfleri bulunan sayıları C:G arasındaki 5 sütuna sıralamak istiyorsunuz değil mi ?
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Barkod numarası ayrıştırma

İleti#5)  okutkan » 23 Tem 2021 02:34

Aşağıdaki kodu deneyebilirsiniz. İlk basamaktaki A,B,C,D,E harici bir harf olursa H sütununda listelenir.
Kod: Tümünü seç
Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "A").End(xlUp).Row 'A sütunu son hücre sayısını verir
Range("C2:H10000").ClearContents 'eski listeleri siler

For i = 1 To son
'Listelenecek sütunlardaki son hücre sayısını verir
sonA = Cells(Rows.Count, "C").End(xlUp).Row + 1
sonB = Cells(Rows.Count, "D").End(xlUp).Row + 1
sonC = Cells(Rows.Count, "E").End(xlUp).Row + 1
sonD = Cells(Rows.Count, "F").End(xlUp).Row + 1
sonE = Cells(Rows.Count, "G").End(xlUp).Row + 1
sonF = Cells(Rows.Count, "H").End(xlUp).Row + 1

'koşullara göre listeleme yapar
If Left(Cells(i, "A"), 1) = "A" Then
Cells(sonA, "C").Value = Cells(i, "A").Value

ElseIf Left(Cells(i, "A"), 1) = "B" Then
Cells(sonB, "D").Value = Cells(i, "A").Value

ElseIf Left(Cells(i, "A"), 1) = "C" Then
Cells(sonC, "E").Value = Cells(i, "A").Value

ElseIf Left(Cells(i, "A"), 1) = "D" Then
Cells(sonD, "F").Value = Cells(i, "A").Value

ElseIf Left(Cells(i, "A"), 1) = "E" Then
Cells(sonE, "G").Value = Cells(i, "A").Value

Else
Cells(sonF, "H").Value = Cells(i, "A").Value
End If
Next i

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

Cevap: Barkod numarası ayrıştırma

İleti#6)  okutkan » 23 Tem 2021 02:54

Aşağıdaki dosyada A sütununda mükerrer girişler yapıp deneyin. Mükerrer giriş olan hücreleri silecek daha sonra yan tarafta listeleme yapacak. Önceki dosyada mükerrer giriş kontrolü yoktu, daha sonradan fark ettim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Barkod numarası ayrıştırma

İleti#7)  skyeagleseo » 23 Tem 2021 04:47

okutkan yazdı:Aşağıdaki dosyada A sütununda mükerrer girişler yapıp deneyin. Mükerrer giriş olan hücreleri silecek daha sonra yan tarafta listeleme yapacak. Önceki dosyada mükerrer giriş kontrolü yoktu, daha sonradan fark ettim.


abim çok eline sağlık teşekkür ederim. office 2007 kullanıyorum.

mükerrer giriş yaptıktan sonra, command butona bastım, herhangi bir işlem yapmadı. acaba nerede hata yapıyorum?

not: makroyu etkinleştir dedim.
Kullanıcı avatarı
skyeagleseo
 
Kayıt: 22 Tem 2021 18:18
Meslek: ofis elemanı
Yaş: 35
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: amasya

Cevap: Barkod numarası ayrıştırma

İleti#8)  okutkan » 23 Tem 2021 11:17

Denedim Mükerrer girişlerde işlem yapıyor. Sağ tarafta Listeleme yapıyor mu ?
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

Cevap: Cevap: Barkod numarası ayrıştırma

İleti#9)  skyeagleseo » 23 Tem 2021 12:07

okutkan yazdı:Denedim Mükerrer girişlerde işlem yapıyor. Sağ tarafta Listeleme yapıyor mu ?


günaydın abim.

A kısmına verileri girip, command butonuna basıyorum. hiçbir hareket olmuyor. ofis sürümümde mi sorun var acaba
Kullanıcı avatarı
skyeagleseo
 
Kayıt: 22 Tem 2021 18:18
Meslek: ofis elemanı
Yaş: 35
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: amasya

Cevap: Barkod numarası ayrıştırma

İleti#10)  okutkan » 23 Tem 2021 12:25

Alt +11 ile kod penceresine girin, f8 ile kodu adımlayarak çalıştırmayı deneyin. Kodun çalışmaması izinlerler ilgili de olabilir.
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

Cevap: Barkod numarası ayrıştırma

İleti#11)  skyeagleseo » 23 Tem 2021 14:25

dediğinizi yaptım abim, aşağıdaki hatayı aldım.

Resim
Kullanıcı avatarı
skyeagleseo
 
Kayıt: 22 Tem 2021 18:18
Meslek: ofis elemanı
Yaş: 35
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: amasya

Cevap: Barkod numarası ayrıştırma

İleti#12)  okutkan » 23 Tem 2021 14:38

Kodları başka bir excel safyasında deneyin. Dosyayı kaydederken makro içeren dosya olarak kaydedin.
Kullanıcı avatarı
okutkan
Site Dostu
 
Kayıt: 27 May 2017 04:45
Meslek: Excel Developer
Yaş: 30
İleti: 1781
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

Cevap: Cevap: Barkod numarası ayrıştırma

İleti#13)  feraz » 23 Tem 2021 22:46

okutkan yazdı:Denedim Mükerrer girişlerde işlem yapıyor. Sağ tarafta Listeleme yapıyor mu ?


Alttaki aynı olanları siler kısa yoldan abey dictionarye gerek kalmadan.

Kod: Tümünü seç
Range("A:A").RemoveDuplicates 1, xlNo
Kullanıcı avatarı
feraz
İstenmeyen Üye
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 43
İleti: 6834
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Barkod numarası ayrıştırma

İleti#14)  feraz » 24 Tem 2021 00:35

Kod: Tümünü seç
Private Sub CommandButton1_Click()

    Dim dic As New Dictionary, arr
    Dim son As Long, i As Long, key As String, say As Long
    Dim dicCount As Long, k As Integer
    Const sutunBAs As Byte = 3
   
    Range("A:A").RemoveDuplicates 1, xlNo
   
    son = Cells(Rows.Count, 1).End(3).Row
    say = 0
    With dic
        .CompareMode = TextCompare
        For i = 1 To son
            key = Left(Cells(i, 1).Value, 1)
            dic(key) = dic(key)
        Next
        dicCount = .Count
        If dicCount > 0 Then
            arr = bubble_sort(dic.Keys, dicCount)
            Range("C1").CurrentRegion.Clear
            Range("C1").Resize(, dicCount).Value = arr
            ReDim arr2(1 To son, 1 To 1)
            For k = sutunBAs To (dicCount - 1) + sutunBAs
                say = 0
                For i = 1 To son
                    If Left(Cells(i, 1).Value, 1) = Cells(1, k).Value Then
                        say = say + 1
                        arr2(say, 1) = Cells(i, 1).Value
                    End If
                Next
                Cells(2, k).Resize(say, 1).Value = arr2
                ReDim arr2(1 To son, 1 To 1)
            Next
        End If
    End With
    On Error Resume Next
    Set dic = Nothing
    Erase arr2: Erase arr
End Sub


Kod: Tümünü seç
Function bubble_sort(dict, say)
    Dim i As Long, k As Long
   
    For i = 0 To say - 1
        For k = i To say - 1
            If dict(i) > dict(k) Then
                veri = dict(i)
                dict(i) = dict(k)
                dict(k) = veri
            End If
        Next
    Next
  bubble_sort = dict
End Function
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
İstenmeyen Üye
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 43
İleti: 6834
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Barkod numarası ayrıştırma

İleti#15)  skyeagleseo » 24 Tem 2021 18:39

arkadaşlar ellerinize sağlık mükemmel bir çalışma oldu. çok teşekkür ederim. iyi ki varsınız
Kullanıcı avatarı
skyeagleseo
 
Kayıt: 22 Tem 2021 18:18
Meslek: ofis elemanı
Yaş: 35
İleti: 6
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: amasya

Cevap: Barkod numarası ayrıştırma

İleti#16)  feraz » 24 Tem 2021 19:11

Rica ederiz.
Buda biraz başka yoldan yapılmış hali.

Kod: Tümünü seç
Private Sub CommandButton1_Click()
    Dim dic As New Dictionary
    Dim key As String, kes() As String
    Dim dicCount As Long, son As Long, i As Long
    Dim say As Long, say2 As Long, say3 As Long
    Dim veri, sirala, arr
   
    Range("A:A").RemoveDuplicates 1, xlNo

    son = Cells(Rows.Count, 1).End(3).Row
    say = 1
    With dic
        .CompareMode = TextCompare
        For i = 1 To son
            key = Left(Cells(i, 1).Value, 1)
            dic(key) = Cells(i, 1).Value & "|" & dic(key)
        Next
       
        say2 = 1
        Range("C1").CurrentRegion.Clear
        ReDim arr(1 To son, 1 To .Count)
        sirala = bubble_sort(dic.Keys)
       
        For Each veri In sirala
            kes = Split(Mid(dic(veri), 1, Len(dic(veri)) - 1), "|")
            arr(1, say2) = Mid(dic(veri), 1, 1)
            For i = UBound(kes) To 0 Step -1
                say3 = say3 + 1
                say = say + 1
                arr(say, say2) = kes(i)
            Next
           
            say2 = say2 + 1
            say = 1
        Next
        Range("C1").Resize(say3, .Count).Value = arr
    End With
    On Error Resume Next
    Set dic = Nothing
    Erase arr
End Sub

Kod: Tümünü seç
Function bubble_sort(arr)
    Dim i As Long, k As Long
   
    For i = LBound(arr) To UBound(arr)
        For k = i To UBound(arr)
            If arr(i) > arr(k) Then
                veri = arr(i)
                arr(i) = arr(k)
                arr(k) = veri
            End If
        Next
    Next
  bubble_sort = arr
End Function
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
İstenmeyen Üye
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 43
İleti: 6834
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray


Forum Ücretli İşlemler

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe