Barkodla Sayım Tarama

[aksoy53]

Yardım yapabilirmisiniz

TKYS Listedeki kitapların Demirbaş numarasına göre tarayacak.

Eğer listede varsa o demirbaş numarasını Bulunan Demirbaş Listesine Ekleyecek ve bu ekranda
bulunduğunu söyleyecek ya da YEŞİL yanacak.

Eğer listede YOK ise Bulunamayan Demirbaşlar Listesine ekleyecek ve Ekran Kırmızı yanacak ya da YOK diyecek

 

[YUSUF44]

Aşağıdaki kodları Tarama sayfasının kod bölümüne (sayfa ismine sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırın. C10 hücresi değiştiğinde istediğiniz işlemi yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C10]) Is Nothing Then Exit Sub
Set s1 = Sheets("TKYS LİSTE")
Set s2 = Sheets("BULUNAN DEMİRBAŞ LİSTESİ")
Set s3 = Sheets("BULUNAMAYAN DEMİRBAŞLAR")
son = s1.Cells(Rows.Count, "A").End(3).Row

If WorksheetFunction.CountIf(s1.Range("A1:A" & son), Target) > 0 Then
    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
    If s2.[A1] = "" Then yeni = 1
    s2.Cells(yeni, "A") = Target
    Target.Interior.Color = vbGreen
Else
    
    yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
    If s3.[A1] = "" Then yeni = 1
    s3.Cells(yeni, "A") = Target
    Target.Interior.Color = vbRed

End If

End Sub

 

[aksoy53]

Çok teşekkür ederim çok değerli ve kayda değerleriniz için bir kez daha teşekkür ederim. Güzel oldu fakat hocam rica etsem 2 tane maddeyi yapabilirmisiniz. çok makbule geçer.

1-tarama sayfasındaki "C10" barkod alaına barkod okutugumda imleç alt hücreye geçmesin sabit kalsın her okuttuğumda orda kalsın
2-Varolan demirbaşlar numaraları TKYS LİSTE de sarı renk olsun

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C10]) Is Nothing Then Exit Sub
Set s1 = Sheets("TKYS LİSTE")
Set s2 = Sheets("BULUNAN DEMİRBAŞ LİSTESİ")
Set s3 = Sheets("BULUNAMAYAN DEMİRBAŞLAR")
son = s1.Cells(Rows.Count, "A").End(3).Row

If WorksheetFunction.CountIf(s1.Range("A1:A" & son), Target) > 0 Then
    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
    If s2.[A1] = "" Then yeni = 1
    s2.Cells(yeni, "A") = Target
    Target.Interior.Color = vbGreen
    Set c = s1.[A:A].Find(Target)
    If Not c Is Nothing Then c.Interior.Color = vbYellow

Else
    
    yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
    If s3.[A1] = "" Then yeni = 1
    s3.Cells(yeni, "A") = Target
    Target.Interior.Color = vbRed

End If
Target.Select
End Sub

İyi çalışmalar.

 

[aksoy53]

Çok teşekkür ederim ellerin dert görmesin