Barkod Okuyucu ile gelişmiş arama

Katılım
26 Kasım 2008
Mesajlar
33
Excel Vers. ve Dili
2010 Tr
Merhabalar.Çok önceden açılmış bir konuya soru sorarak halletmeye çalıştım problemimi ama konu çok eski.Cevap veren olmadı.Belki bana yardımcı olabilecek büyüklerim vardır diye konuyu tekrar açmak istedim.



Sorum şöyle ;


Aynı excel sayfası içinde 4 ayrı aranacak hücre olsaydı ve bu 4 hücreden birine girilen değeri yine B sütununda arayıp bulduğunda da imleci 4 ayrı sütundan hangisine kodlanmışsa o sütuna otomatik taşımasını nasıl yapabilirdik?
Yani örnekle anlatırsam; K2'ye girdiğim değeri,B Sütünda arayıp bulup,o satırın E2 hücresine,L2'ye girdiğim değeri,B Sütünda Arayıp bulup o satırın F2 hücresine,M2'ye girdiğim değeri,B Sütünda Arayıp bulup o satırın G2 hücresine;N2'ye girdiğim değeri,B Sütünda Arayıp bulup o satırın H2 hücresine imleci getirebilirmiyiz?.(Arama hücrelerinden her defasında sadece 1'ine değer girilecektir.Arama hücrelerinde aynı anda birden fazla hücrede veri olmayacaktır.)


Eski konu şurada : http://www.excel.web.tr/f14/barkod-okuyucu-ile-arama-t81866.html
 

Ekli dosyalar

Katılım
26 Kasım 2008
Mesajlar
33
Excel Vers. ve Dili
2010 Tr
Yardımlarınızı halen bekliyorum

Böyle bir kodu var bunu isteğime uyarlayabilecek biri varmı acaba?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
'If Intersect(Target, [aw1]) Is Nothing Then Exit Sub
Set s1 = Sheets("Sayfa1")

If s1.[aw1].Value <> "" Then
    With s1.Range("B:B")
        Set Bul = .Find([aw1], LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            s1.Cells(Bul.Row, "al").Select
        End If
    End With
End If

If Target.Column = 3 Then
s1.[aw1].Select
End If
son:
Set Bul = Nothing
Set s1 = Nothing
End Sub
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,405
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Kodunuz aşağıdadır, Sayfa1'in kod bölümüne kopyalayınız.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("K2:N2")) Is Nothing Then Exit Sub
Set s1 = Sheets("Sayfa1")

If Target.Value <> "" And Target.Cells.Count = 1 Then
    With s1.Range("B:B")
        Set Bul = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            s1.Cells(Bul.Row, Target.Column - 6).Select
        End If
    End With
End If

Set Bul = Nothing
Set s1 = Nothing
End Sub
 
Katılım
26 Kasım 2008
Mesajlar
33
Excel Vers. ve Dili
2010 Tr
Allah razı olsun mucit77.Bugün bana çifte bayram oldu.Ellerin dert görmesin :)
 
Üst