Kapalı Dosyada İsim Arama

[yerbakili]

Merhaba,

yapmaya çalıştığım bir uygulamada epey takıldım. İsteğim, sorgu sayfasının a kolonuna yazdığım isimleri, data (xlsx) çalışma kitabında arayıp bulduğu ismin tablo sayısını b sütunundaki ilgili hücreye yazdırmak istiyorum. Örnek ektedir. Örnek data dosyasında 8 tablo bulunuyor ama gerçek data dosyamda epey bir tablo bulunacak. Bir çok kod ve örnek uygulama denedim ama bir türlü istediğim sonucu alamadım. Yardımcı olabilirseniz sevinirim.

 

[yerbakili]

Yol gösterebilecek yok mudur acaba?

 

[Korhan Ayhan]

Merhaba,

İki dosyayı aynı klasör altına alın.

Sorgu isimli dosyanızda Sayfa1 isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

A sütununa isim yazıp sonucu gözlemleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range
    If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Target = "" Then Target.Next = ""
    If Target <> "" Then
        Set K1 = Workbooks.Open(ThisWorkbook.Path & "\data.xlsx")
        Set BUL = K1.Sheets("GENEL LİSTE").Cells.Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
            If BUL.Row < 21 Then
                Target.Next = K1.Sheets("GENEL LİSTE").Cells(2, BUL.Column)
            Else
                Target.Next = K1.Sheets("GENEL LİSTE").Cells(21, BUL.Column)
            End If
        End If
        K1.Close False
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[yerbakili]

Merhaba,

İki dosyayı aynı klasör altına alın.

Sorgu isimli dosyanızda Sayfa1 isimli sayfanızın kod bölümüne aşağıdaki kodu uygulayın.

A sütununa isim yazıp sonucu gözlemleyin.

Öncelikle yardımlarınız için teşekkür ederim. Ancak, data dosyama 3 bir tablo satırı eklediğimde örneğin (A9-A10-A11-A12), A12 tablosunda olması gereken ismi bir üstteki tabloda yani A8'de gösteriyor. Bunu nasıl düzeltebiliriz acaba?

 

[Korhan Ayhan]

Merhaba,

Ben dosyanızın sabit veri içerdiğini düşünmüştüm. Değişken olduğu durumlarda aşağıdaki kodu kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range
    If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Target = "" Then Target.Next = ""
    If Target <> "" Then
        Set K1 = Workbooks.Open(ThisWorkbook.Path & "\data.xlsx")
        Set BUL = K1.Sheets("GENEL LİSTE").Cells.Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
            Target.Next = BUL.End(3)
        End If
        K1.Close False
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[yerbakili]

Merhaba,

Ben dosyanızın sabit veri içerdiğini düşünmüştüm. Değişken olduğu durumlarda aşağıdaki kodu kullanabilirsiniz.

Yardımınız için çok teşekkür ederim. Kodlar tam istediğim gibi çalışıyor. Ancak, data dosyamda örneğin A3 tablosunda alt alta3 isim yazılıyken ve 4. satır boş bırakılıp diğer satırlar doluyken 7. sıradaki kişiyi sorgulattığımda 5.satırdaki isim sonuç olarak veriliyor. Bunu çözmek için ne yapabilirim? Boş hücreleri "-" ile doldurma şansımız var mı acaba?

 

[Korhan Ayhan]

Merhaba,

Farkındamısınız çözüm sundukça sürekli sorun üretiyorsunuz. Bu durumda bütün koşulları söyleyinki ona göre çözüm üretelim. Bu şekilde başlık boşu boşuna uzayıp gidiyor.

Eğer sıra numaralarında atlama yoksa bunuda kullanabiliriz.

 

[yerbakili]

Merhaba,

Farkındamısınız çözüm sundukça sürekli sorun üretiyorsunuz. Bu durumda bütün koşulları söyleyinki ona göre çözüm üretelim. Bu şekilde başlık boşu boşuna uzayıp gidiyor.

Eğer sıra numaralarında atlama yoksa bunuda kullanabiliriz.

Haklısınız, farkındayım. Ancak son sorunumu yarım gündür internette aramama rağmen son sorunuma bir türlü uygun çözüm bulamadım. Konuyu saptırdığım için özür dilerim.

 

[Korhan Ayhan]

Tablonuzda sorgulanabilecek alanları gözününe alarak sonuca gidebiliriz.

Sıra numaraları (eğer arada boşluk yoksa)
A1-A2 ... şeklinde giden isimlerin yazı fontu 16 olarak ayarlı bu değerde sorgulanabilir. Ya da rengil sorgulanabilir.

Kararınızı bildirirseniz kodu ona göre düzenlerim.

 

[yerbakili]

Tablonuzda sorgulanabilecek alanları gözününe alarak sonuca gidebiliriz.

Sıra numaraları (eğer arada boşluk yoksa)
A1-A2 ... şeklinde giden isimlerin yazı fontu 16 olarak ayarlı bu değerde sorgulanabilir. Ya da rengil sorgulanabilir.

Kararınızı bildirirseniz kodu ona göre düzenlerim.

Çok özür dileyerek ve son kez olmak kaydıyla yazı fontu 16 olan önerinizi kullanarak kodu düzenleyebilirseniz çok minnettar olurum. Saygılar.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range, X As Long
    If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Target = "" Then Target.Next = ""
    If Target <> "" Then
        Set K1 = Workbooks.Open(ThisWorkbook.Path & "\data.xlsx")
        Set BUL = K1.Sheets("GENEL LİSTE").Cells.Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
            For X = BUL.Row To 1 Step -1
                If K1.Sheets("GENEL LİSTE").Cells(X, BUL.Column).Font.Size = 16 Then
                    Target.Next = K1.Sheets("GENEL LİSTE").Cells(X, BUL.Column)
                    Exit For
                End If
            Next
        End If
        K1.Close False
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[yerbakili]

Aşağıdaki kodu deneyiniz.

Mükemmel, tam istediğim gibi çalışıyor. Yardımlarınız için çok teşekkür ederim. Allah razı olsun.