barkot numarası ile hücreye geçiş

[dyt.nevzat]

Merhabalar Değerli excel.web kullanıcıları.

çalıştığım gıda işletmesinde stok ve envanter takip sistemi oluşturmaya çalışıyorum excel üzerinden. tüm ürünlerin barkot numaralarını excel e aktardım. eğer formulünü kullanarak okutulan barkot numarası var ise o ürüne ait sütuna 1 yoksa 0 yazıyor ve toplamlar için ise bir toplam hücresi oluşturdum. bu şekilde giren yada çıkan katagorisinden birini tam olarak kayıt altına alabiliyorum. sorunum ise giriş-çıkış ve iade sutunları oluştursam ve bu sütunlara gene bir barkot kodu tanımlasam üretimdeki yahut nakliyedeki personel öncelikle giriş barkotunu okutup sonra üretilen ürünleri okutsun tüketilen yahut nakliye olacak ürünler için ise önce çıkış barkotunu okutsun daha sonra çıkacak ürünleri okutsun istiyorum. bu şekilde günlük girdi çıktı ve güncel stok durumunu takip edebilirim. çözemediğim nokta ise barkot okuyucu ile atadığım barkot numarasını okutup otomatik hücre değiştirmek mümkün müdür. ilginiz ve yardımlarınız için şimdiden çok teşekkür ediyorum. İyi Çalışmalar diliyorum.

 

[YUSUF44]

Mümkündür ama bunun için dosya yapısını ve tam olarak nasıl bir düzenleme istediğinizi örneklerle görmemiz iyi olur.

 

[dyt.nevzat]

https://s7.dosya.tc/server16/71b30m/stok_takip_exel__Kurtarildi_.xlsx.html

bu linke yükleme yaptım acemice bir çalışma oldu

barkod kısmı sabit bir şekilde kalıyor okutulan barkot kodları sutunda yok ise ilgili haneye ''0'' var ise ''(1) yazıyor. sonrasında bir toplama işlemi ve 2. sayfaya toplamını aktardım. ancak sadece giriş veya çıkış yapabiliyorum bu işlem ile yapmak istediğim iş ise biraz daha karmaşık.. giriş-çıkış-iade ve nakliye de ki personeller için barkot oluşturmak niyetindeyim . Bu sayede A kişisi öncelikle kendine ait barkotu okutup sonra ürün barkotuna geçiş yapsın bende herhangi bir müdehalede bulunmadan depolardan kim ne almış göreyim istiyorum

 

[YUSUF44]

Belirttiğiniz gibi çok acemice bir çalışma ve maalesef de açıklama olmuş. Ne yapmak istediğiniz dosyanızdan ve açıklamanızdan anlaşılmıyor. Dosyanızdaki sayfalar ne işe yarıyor? O sayfalardaki sütunlar ve satırlar ne işe yarıyor? Bizden dosyanın neresinde nasıl bir değişiklik ya da ilave yapmamızı istiyorsunuz?

 

[dyt.nevzat]

sıralı bir şekilde anlatmaya çalışacam ;

D6 hücresine giriş - E6 Hücresine Çıkış İsmi verilecek
Giriş- ve Çıkış isminde web den barkot oluşturacağım
C6 sutununda Giriş Barkotu okutulduğunda bir sonraki değerler (barkot numarası) D6 sutunundan devam edecek

yani C,D ve E sutunlarından her hangi birinde Giriş barkotu okutulduğunda D6, çıkış Barkotu okutulduğunda E6 stununa geçip oradan devam etmesini istiyorum.

=EĞER(C7=12345678910851;D6 sutununa git) gibi bir komut lazım açıkcası

 

[YUSUF44]

Sanıyorum bu işlemi Sayfa1'de yapacaksınız. Aşağıdaki kodları bu sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin. Kodlarda yer alan Giriş Barkodu ve Çıkış Barkodu ifadelerini kendi giriş ve çıkış barkodlarınızla değiştirin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C7:C" & Rows.Count)) Is Nothing Then Exit Sub
If Target = "Giriş Barkodu" Then
    Target.Offset(0, 1).Select
ElseIf Target = "Çıkış Barkodu" Then
    Target.Offset(0, 2).Select
Else
    Exit Sub
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
a = Target.Row
If Not Intersect(Target, Range("D7:D" & Rows.Count)) Is Nothing Then
    If Cells(a, "C") = "Çıkış Barkodu" Then
        Target.Offset(0, 1).Select
    ElseIf Cells(a, "C") <> "Giriş Barkodu" Then
            MsgBox "Bu sütuna giriş yapabilmek için C sütununa giriş barkodu okutmanız gerekmektedir!", vbCritical
            Cells(a, "C").Select
        Exit Sub
    End If
ElseIf Not Intersect(Target, Range("E7:E" & Rows.Count)) Is Nothing Then
    If Cells(a, "C") <> "Çıkış Barkodu" Then
            MsgBox "Bu sütuna giriş yapabilmek için C sütununa çıkış barkodu okutmanız gerekmektedir!", vbCritical
            Cells(a, "C").Select
    End If
End If
End Sub

 

[dyt.nevzat]

çok teşekkür ediyorum ancak bir sorunum var giriş yahut çıkış sutunundan devam etmiyor her seferinde C sutununa geri dönüyor..

D : sutunu giriş
E: sutunu çıkış

giriş barkotunu okuttuğumda D stununa geçip çıkış barkotunu okutana kadar alt satırlara devam etmesi ve çıkış barkotunu okuttuğumda ise E stununa geçip giriş barkotu okutuluncaya kadar oradan devam etmesi tüm problemlerimi çözecek. bu hususta yardımcı olabilirseniz minnettar kalırım. Elinize Emeğinize sağlık şimdiden .

 

[YUSUF44]

Aşağıdaki kodları deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C7:C" & Rows.Count)) Is Nothing Then GoTo 10
If Target = "Giriş Barkodu" Then
    Target.Offset(0, 1).Select
ElseIf Target = "Çıkış Barkodu" Then
    Target.Offset(0, 2).Select
Else
    Exit Sub
End If
10:
If Intersect(Target, Range("D7:E" & Rows.Count)) Is Nothing Then Exit Sub
If Target <> "" Then
    Application.EnableEvents = False
        Target.Offset(1, 0).Select
    Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
a = Target.Row
son = Cells(Rows.Count, "C").End(3).Row
If Not Intersect(Target, Range("D7:D" & Rows.Count)) Is Nothing Then
    If Cells(a, "C") = "Çıkış Barkodu" Or Cells(son, "C") = "Çıkış Barkodu" Then
        Target.Offset(0, 1).Select
    ElseIf Cells(a, "C") <> "Giriş Barkodu" And Cells(son, "C") <> "Giriş Barkodu" Then
        MsgBox "Bu sütuna giriş yapabilmek için C sütununa giriş barkodu okutmanız gerekmektedir!", vbCritical
        Cells(a, "C").Select
        Exit Sub
    End If
ElseIf Not Intersect(Target, Range("E7:E" & Rows.Count)) Is Nothing Then
    If Cells(a, "C") <> "Çıkış Barkodu" And Cells(son, "C") <> "Çıkış Barkodu" Then
        MsgBox "Bu sütuna giriş yapabilmek için C sütununa çıkış barkodu okutmanız gerekmektedir!", vbCritical
        Cells(a, "C").Select
    End If
End If
End Sub

 

[dyt.nevzat]

bu sutuna giriş yapabilmeniz için C sutununa giriş/çıkış barkotu okutmanız gerekmektedir hatası veriyor. dolayısıyla bir alt hücreye geçiş yaparak ilerlemiyor malesef.

 

[YUSUF44]

C sütununda altta bir yerlerde bir hücre var, barkod numarası yazılı. Onu silmeniz gerek. Kod son dolu satırı da dikkate aldığı için ve altta dolu satır olduğu için bu oluyor.

 

[dyt.nevzat]

İndir output (2)

Dosyayı indir output (2)

dosya.co

giriş ve çıkış sutunları arasında geçiş yapması mümkün mü acaba?

çıkış sutunundayken giriş barkodu girildiğinde giriş sutununa geçse
aynı şekilde giriş sutunundayken çıkış barkodu girildiğinde çıkış sutununa girse

 

[YUSUF44]

Bir sorun haricinde isteğiniz aşağıdaki şekilde oluyor. Olmayan kısım ise E sütununa Giriş Barkodu girdikten sonra Enter'e basar ya bir alt hücreyi seçerseniz imleç C sütununda kalıyor. Giriş yapmak için D sütununa kendinizin geçmesi gerekiyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C7:C" & Rows.Count)) Is Nothing Then GoTo 10
If Target = "Giriş Barkodu" Then
    Target.Offset(0, 1).Select
ElseIf Target = "Çıkış Barkodu" Then
    Target.Offset(0, 2).Select
Else
    Exit Sub
End If
10:
If Intersect(Target, Range("D7:E" & Rows.Count)) Is Nothing Then Exit Sub
If Target <> "" Then
    Application.EnableEvents = False
        If Target = "Giriş Barkodu" Then
            son = WorksheetFunction.Max(Cells(Rows.Count, "C").End(3).Row, Cells(Rows.Count, "D").End(3).Row, _
                    Cells(Rows.Count, "E").End(3).Row, 6)
            Cells(son + 1, "C") = Target
            Cells(son + 1, "D").Select
        ElseIf Target = "Çıkış Barkodu" Then
            son = WorksheetFunction.Max(Cells(Rows.Count, "C").End(3).Row, Cells(Rows.Count, "D").End(3).Row, _
                    Cells(Rows.Count, "E").End(3).Row, 6)
            Cells(son + 1, "C") = Target
            Cells(son + 1, "E").Select
        Else
            Target.Offset(1, 0).Select
        End If
    Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
a = Target.Row
son = Cells(Rows.Count, "C").End(3).Row
Application.EnableEvents = False
    If Not Intersect(Target, Range("D7:D" & Rows.Count)) Is Nothing Then
        If Cells(a, "C") = "Çıkış Barkodu" Or Cells(son, "C") = "Çıkış Barkodu" Then
            Target.Offset(0, 1).Select
        ElseIf Cells(a, "C") <> "Giriş Barkodu" And Cells(son, "C") <> "Giriş Barkodu" Then
            Cells(a, "C").Select
            Application.EnableEvents = True
            Exit Sub
        End If
    ElseIf Not Intersect(Target, Range("E7:E" & Rows.Count)) Is Nothing Then
        If Cells(a, "C") <> "Çıkış Barkodu" And Cells(son, "C") <> "Çıkış Barkodu" Then
            Cells(a, "C").Select
        End If
    End If
Application.EnableEvents = True
End Sub

 

[dyt.nevzat]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D7" & Rows.Count)) Is Nothing Then GoTo 10
If Target = "Giriş Barkodu" Then
Target.Offset(0, 1).Select
ElseIf Target = "Çıkış Barkodu" Then
Target.Offset(0, 2).Select
Else
Exit Sub
End If
10:
If Intersect(Target, Range("D7:E" & Rows.Count)) Is Nothing Then Exit Sub
If Target <> "" Then
Application.EnableEvents = False
If Target = "Giriş Barkodu" Then
son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, Cells(Rows.Count, "D").End(3).Row, _
Cells(Rows.Count, "E").End(3).Row, 6)
Cells(son + 1, "D") = Target
Cells(son + 1, "D").Select
ElseIf Target = "Çıkış Barkodu" Then
son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, Cells(Rows.Count, "D").End(3).Row, _
Cells(Rows.Count, "E").End(3).Row, 6)
Cells(son + 1, "D") = Target
Cells(son + 1, "E").Select
Else
Target.Offset(1, 0).Select
End If
Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
a = Target.Row
son = Cells(Rows.Count, "D").End(3).Row
Application.EnableEvents = False
If Not Intersect(Target, Range("D7" & Rows.Count)) Is Nothing Then
If Cells(a, "D") = "Çıkış Barkodu" Or Cells(son, "D") = "Çıkış Barkodu" Then
Target.Offset(0, 1).Select
ElseIf Cells(a, "D") <> "Giriş Barkodu" And Cells(son, "D") <> "Giriş Barkodu" Then
Cells(a, "D").Select
Application.EnableEvents = True
Exit Sub
End If
ElseIf Not Intersect(Target, Range("E7:E" & Rows.Count)) Is Nothing Then
If Cells(a, "D") <> "Çıkış Barkodu" And Cells(son, "D") <> "Çıkış Barkodu" Then
Cells(a, "D").Select
End If
End If
Application.EnableEvents = True
End Sub


C sutununu tamamen iptal ettim ve hedefime uşaltım..

Bana Yardımcı olan Yusuf Beye çok çok teşekkür ediyorum. İyiki Varsınız. Sabrınız ve Emeğiniz için Minnettarım.