Veri Arama

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Veri Arama

İleti#1)  m48a5t1 » 12 Şub 2020 13:50

Merhabalar,

Eklediğim örnek dosyasında veri sekmesindeki bilgileri , Arama sekmesinde arama yaparak çekmek istiyorum.
Arama sayfasında bir kutucuk olacak buraya yazılan bilgi veri sekmesinde aranarak o bilginin eşleştiği satırların hepsi alt taraftaki aynı sıradaki başlıkların altına alt alta sıralanmasını istiyorum.. Boşluk , nokta , sılaş, tire , virgül gibi ayrımları da yapabilmesi , ayrıca arama kutusunda yazılan ibarenin bir kısmının eşleşmesi bile çekmek için yeterli olabilecek şekilde kodlama yapılabilir mi ?

Konu hakkında yardımlarınızı rica eder , şimdiden teşekkür ederim.

https://drive.google.com/file/d/1GPooRpm34y_ens14WPj2KZD9iWAz3WrN/view?usp=sharing
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#2)  m48a5t1 » 12 Şub 2020 14:11

Merhaba,

Boşluk , nokta , sılaş, tire , virgül gibi ayrımları da yapabilmesi derken. Yok sayması anlamında yazdım..

Örnek : 123-345-as veri arama kutusunda yazılı hali olsun

Veri kısmında 123345as veya 123 345 as veya 123.345.as gibi vs. şekillerde veri olabilir ..
bu veriler ile eşleşip getirmesi önemli..
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#3)  m48a5t1 » 12 Şub 2020 15:47

Merhaba,

2014 yılında yapılan bu kodlama üzerinden noktalama işaretleri slaş , nokta , tire boşluk vs. gibi şeylerin arama esnasında yok sayılması hususunu bu kodların üzerinden düzenleyebilir miyiz acaba..

yardımlarınız için şimdiden teşekkür ederim.

Yeni örnek dosya

https://drive.google.com/file/d/1e8Binj6gp98Qqxg78Q0UWmrEHNjOFLV9/view?usp=sharing

Kod: Tümünü seç
Sub deneme2()
    Application.ScreenUpdating = False
    Dim aranan$, satir&, bul As Range, ilk_adres$
    With Sayfa2
        .Range("A4:M" & .Rows.Count).ClearContents
        aranan = .TextBox1.Text
        If aranan <> Empty Then
            Set bul = Sayfa1.Range("A:N").Find(aranan, Lookat:=xlPart)
            If Not bul Is Nothing Then
                satir = .Cells(.Rows.Count, 2).End(3).Row + 1
                ilk_adres = bul.Address
                Do
                    .Range("A" & satir & ":N" & satir).Value = Sayfa1.Range("A" & bul.Row & ":N" & bul.Row).Value
                    satir = satir + 1
                    Set bul = Sayfa1.Range("A:N").FindNext(bul)
                Loop While Not bul Is Nothing And bul.Address <> ilk_adres
            End If
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "BİLGİ"
    aranan = Empty: satir = Empty: Set bul = Nothing: ilk_adres = Empty
End Sub
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#4)  Miraç CAN » 12 Şub 2020 16:47

viewtopic.php?f=6&t=34826
En sonda ki kodları uyarlayabilirsiniz kendinize göre.
ListBox2 yerine sayfa ismi, .List(colmn, 0) yerine hücre ismi, ComboBox1.Text yerine arama kutucuğunzun ismi gibi değişikleri yapabilir misiniz?
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

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

Cevap: Cevap: Veri Arama

İleti#5)  m48a5t1 » 13 Şub 2020 08:20

Miraç CAN yazdı:http://excelvba.net/viewtopic.php?f=6&t=34826
En sonda ki kodları uyarlayabilirsiniz kendinize göre.
ListBox2 yerine sayfa ismi, .List(colmn, 0) yerine hücre ismi, ComboBox1.Text yerine arama kutucuğunzun ismi gibi değişikleri yapabilir misiniz?



Merhaba Miraç bey,

Kodlama bilgim olmadığı için tam olarak ne yapmam gerektiğini bilemiyorum.. Örnek dosya üzerinden bu değişikliği yapabilir misiniz sizin için zahmet olmaz ise..

Şimdiden teşekkür ederim..
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#6)  Miraç CAN » 13 Şub 2020 10:07

Dosyanızda Sayfa/uygulama gizlemeVisible özelliklerini ve varsa şifreleri, özel bilgileri arındırarak eklediniz değil mi?
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Veri Arama

İleti#7)  m48a5t1 » 13 Şub 2020 10:21

Miraç CAN yazdı:Dosyanızda Sayfa/uygulama gizlemeVisible özelliklerini ve varsa şifreleri, özel bilgileri arındırarak eklediniz değil mi?


Merhaba,

Evet..
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#8)  Miraç CAN » 13 Şub 2020 11:02

m48a5t1 yazdı:Merhaba,

2014 yılında yapılan bu kodlama üzerinden noktalama işaretleri slaş , nokta , tire boşluk vs. gibi şeylerin arama esnasında yok sayılması hususunu bu kodların üzerinden düzenleyebilir miyiz acaba..

Yok sayması derken, arama yaparken bunları gözardı ederek mi arasın istiyorsunuz? yoksa bunlara karşı da duyarlı bir arama mı?
Gözardı edilecekse, bu işaretlerin tam bir listesi gerekiyor.
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: Cevap: Veri Arama

İleti#9)  m48a5t1 » 13 Şub 2020 11:06

Miraç CAN yazdı:
m48a5t1 yazdı:Merhaba,

2014 yılında yapılan bu kodlama üzerinden noktalama işaretleri slaş , nokta , tire boşluk vs. gibi şeylerin arama esnasında yok sayılması hususunu bu kodların üzerinden düzenleyebilir miyiz acaba..

Yok sayması derken, arama yaparken bunları gözardı ederek mi arasın istiyorsunuz? yoksa bunlara karşı da duyarlı bir arama mı?
Gözardı edilecekse, bu işaretlerin tam bir listesi gerekiyor.

Merhaba,

1 /
2 -
3 .
4 ,
5 ;
6 :
7 Boşluk


Veri sayfasında bu şekilde kayıtlı olabilir ama veri arama esanasında bunlarsız arama yapıldığınıda veri bulup getirmesini istiyorum..

Kolay gelsin
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#10)  Miraç CAN » 13 Şub 2020 13:59

Kod: Tümünü seç
Private Sub TextBox1_Change()
ActiveSheet.Unprotect
Dim filtre() As String, wdt As Single, ws As Worksheet
Dim script As Object, ürün As String, cl As Single
Dim liste As Variant, veri() As String, Rw As Single, Rmw() As Variant, son As Single
Set ws = Sheets("Veri"): son = ws.Cells(Rows.Count, 1).End(xlUp).Row
Range("B5", Cells(Rows.Count, Columns.Count)).ClearContents
Rmw = Array("/", "-", ".", ",", ";", ":", " ")
wdt = ws.Cells(1, 1).End(xlToRight).Column
kriter = Application.Match(Cells(2, 2), ws.Range(ws.Cells(1, 1), ws.Cells(1, 1).End(xlToRight)), 0)
Set script = CreateObject("Scripting.Dictionary")
With script
    For Rw = 2 To son
        ürün = Evaluate("=upper(""" & ws.Cells(Rw, kriter).Text & """)")
        For cl = LBound(Rmw) To UBound(Rmw)
            ürün = Replace(ürün, Rmw(cl), Empty)
        Next
        .Add ürün, ws.Cells(Rw, 1).Text
        For cl = 2 To wdt Step 1
            .Item(ürün) = .Item(ürün) & ";" & ws.Cells(Rw, cl).Text
        Next cl
    Next Rw
    filtre = Filter(.Keys, Evaluate("=upper(""" & TextBox1.Text & """)"), True)
End With
For Each liste In filtre
    veri = Split(script.Item(liste), ";")
    Rw = Cells(Rows.Count, 2).End(xlUp).Row + 1
    For cl = 0 To UBound(veri)
        Cells(Rw, cl + 2) = veri(cl)
    Next cl
Next liste
ActiveSheet.Protect
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: Veri Arama

İleti#11)  m48a5t1 » 14 Şub 2020 09:07

Merhaba,

Site dışından bir arkadaşım mevcut kod üzerinden ekleme yaptı. Arama kutucuğunda işaretlemeler yok sayılarak veri sayfasında aranıyor , ancak eksik olan kısım veri sayfasındaki işaretlerinde yok sayılarak aranması.. Bunun için bu koda ekleme yapılırsa aranan kutusundaki veri işaretler yok sayılarak veri kısmındaki işaretler yok sayılarak aranacak ve tam eşleşen satırlar sonuç kısmına getirilecek..

Kısaca anlatmak istediğim; arama yaparken veri kısmındaki işaretlerinde yok sayılarak aranması..

Bunun için destek vermenizi rica ederim..


Kod: Tümünü seç
Sub deneme2()
    Application.ScreenUpdating = False
    Dim aranan$, satir&, bul As Range, ilk_adres$
    With Sayfa2
        .Range("A4:M" & .Rows.Count).ClearContents
        aranan = Replace(.TextBox1.Text, "/", "")
        aranan = Replace(aranan, "-", "")
        aranan = Replace(aranan, ".", "")
        aranan = Replace(aranan, ",", "")
        aranan = Replace(aranan, ";", "")
        aranan = Replace(aranan, ":", "")
        aranan = Replace(aranan, " ", "")
        aranan = Replace(aranan, "*", "")
       
        If aranan <> Empty Then
       
                Set bul = Sayfa1.Range("A:N").Find(aranan, Lookat:=xlPart)
            If Not bul Is Nothing Then
                satir = .Cells(.Rows.Count, 2).End(3).Row + 1
                ilk_adres = bul.Address
                Do
                Rmw = Array("/", "-", ".", ",", ";", ":", " ", "*")
                    .Range("A" & satir & ":N" & satir).Value = Sayfa1.Range("A" & bul.Row & ":N" & bul.Row).Value
                    satir = satir + 1
                    Set bul = Sayfa1.Range("A:N").FindNext(bul)
                Loop While Not bul Is Nothing And bul.Address <> ilk_adres
            End If
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "BİLGİ"
    aranan = Empty: satir = Empty: Set bul = Nothing: ilk_adres = Empty
End Sub
Kullanıcı avatarı
m48a5t1
Yeni Başlamış
 
Kayıt: 15 Ekm 2014 15:48
Meslek: OTO YEDEK PARÇA SATINALMA
Yaş: 40
İleti: 58
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Veri Arama

İleti#12)  Miraç CAN » 14 Şub 2020 16:57

Önceki cevapta ki örnek dosyanın ilgili kodlarını değiştirin;
Kod: Tümünü seç
Private Sub TextBox1_Change()
ActiveSheet.Unprotect
Dim filtre() As String, wdt As Single, ws As Worksheet, arama As String
Dim script As Object, ürün As String, cl As Single, kriter As Single
Dim liste As Variant, veri() As String, Rw As Single, Rmw() As Variant, son As Single
Set ws = Sheets("Veri"): son = ws.Cells(Rows.Count, 1).End(xlUp).Row
Range("B5", Cells(Rows.Count, Columns.Count)).ClearContents
Rmw = Array("/", "-", ".", ",", ";", ":", " ")
wdt = ws.Cells(1, 1).End(xlToRight).Column
kriter = Application.Match(Cells(2, 2), ws.Range(ws.Cells(1, 1), ws.Cells(1, 1).End(xlToRight)), 0)
arama = Evaluate("=upper(""" & TextBox1.Text & """)")
For cl = LBound(Rmw) To UBound(Rmw)
    arama = Replace(arama, Rmw(cl), Empty)
Next
Set script = CreateObject("Scripting.Dictionary")
With script
    For Rw = 2 To son
        ürün = Evaluate("=upper(""" & ws.Cells(Rw, kriter).Text & """)")
        For cl = LBound(Rmw) To UBound(Rmw)
            ürün = Replace(ürün, Rmw(cl), Empty)
        Next
        .Add ürün, ws.Cells(Rw, 1).Text
        For cl = 2 To wdt Step 1
            .Item(ürün) = .Item(ürün) & ";" & ws.Cells(Rw, cl).Text
        Next cl
    Next Rw
    filtre = Filter(.Keys, arama, True)
End With
For Each liste In filtre
    veri = Split(script.Item(liste), ";")
    Rw = Cells(Rows.Count, 2).End(xlUp).Row + 1
    For cl = 0 To UBound(veri)
        Cells(Rw, cl + 2) = veri(cl)
    Next cl
Next liste
ActiveSheet.Protect
End Sub
Kullanıcı avatarı
Miraç CAN
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana


Forum Genel Makro Soruları

Online Kullanıcılar

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

Bumerang - Yazarkafe