- Katılım
- 31 Ağustos 2007
- Mesajlar
- 15
- Excel Vers. ve Dili
- 2010
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub BUL_İŞARET_EKLE()
Dim Sayfa As Worksheet, Aranan_Veri As Variant
Dim Bul As Range, Adres As String
Aranan_Veri = Application.InputBox("Lütfen aramak istediğiniz veriyi giriniz !", "ARANAN VERİ")
If Aranan_Veri = False Then
MsgBox "Arama işlemi iptal edilmiştir.", vbInformation
Exit Sub
End If
If Aranan_Veri = "" Then
MsgBox "Lütfen aramak istediğiniz veriyi giriniz !", vbExclamation
Exit Sub
End If
For Each Sayfa In Worksheets
Set Bul = Sayfa.Cells.Find(Aranan_Veri, LookAt:=xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Sayfa.Range(Adres).Offset(0, 1) = "*"
Set Bul = Sayfa.Cells.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Selamlar,
Sn. TheDarkness,
Siz barkod okuyucudan veri okuttuğunuz zaman veriyi excel hücresine atabiliyor musunuz? Eğer bu işlemi yapabiliyorsanız sabit bir sayfaya bu veriyi belli bir hücreye atarak bu hücrenin değişiminde çalışacak şekilde kodu düzenleyebiliriz.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sayfa As Worksheet, Say As Integer
Dim Bul As Range, Adres As String
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
If Target = "" Then
MsgBox "Lütfen aramak istediğiniz veriyi giriniz !", vbExclamation
Target.Select
Exit Sub
End If
For Each Sayfa In Worksheets
If Sayfa.Name <> "BARKOD" Then
Set Bul = Sayfa.Cells.Find(Target, LookAt:=xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Sayfa.Select
Sayfa.Range(Bul.Address).Offset(0, 1) = "*"
Sayfa.Range(Bul.Address).Select
Say = Say + 1
Set Bul = Sayfa.Cells.FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
End If
Next
If Say = 0 Then MsgBox Target & " nolu barkod bulunamamıştır !", vbExclamation, "Dikkat !"
End Sub
Set Bul = Cells.Find(Aranan_Veri, LookAt:=xlWhole)
Set Bul = Cells.Find(Aranan_Veri, LookAt:=xlPart)
Selamlar,
Sn. TheDarkness,
#15 nolu mesajımdaki kodu ve dosyayı güncelledim. İncelermisiniz.