Çözüldü EXCEL DOSYASINDA ARAMA MOTORU MANTIĞI İLE ARAMA YAPTIRMA

[ttb]

Merhaba,
Herkese mutlu bir gün dilerim.
İnternette kısa bir video izledim (https://www.instagram.com/reel/CvsKaqntHFF/?igshid=NjIwNzIyMDk2Mg==). Bir kullanıcı excelde, dosya içindeki tüm sheetlerde arama yapacak bir formül yazdı ve B3 hücresine aramak istediği kelimeyi yazınca, bu kelimenin geçtiği satırlar, bir arama motoru mantığı ile fomülü yazdığı hücreye ve altındaki hücrelere sıralandı.
=IFERREOR(FILTER(VSTACK(USA;EUROPE;ASIA);ISNUMBER(SEARCH($B$3;VSTACK(USA;EUROPE;ASIA))));“No Value”
Formül içindeki USA, EUROPE ve ASIA kısımları, dosyadaki sheetlerde yer alan tabloların adları.
Ben formülü kullanamadım; FILTER fonksiyonu Excel 2016'da yokmuş.
Buna benzer bir formül ya da bir makro var mıdır? Örneğin kendi tablomdaki "Arama" adlı bir sheetteki B3 hücresine yazdığım kelime/kelimeleri, tablodaki tüm sheetlerde aratıp liste şeklinde dökmem mümkün olur mu?
Teşekkür ederim.

 

[Greenblacksea53]

Ekte size örnek olacak dosyayı ekledim, kendine uyarlayabilirsiniz..

 

[mesuttasar]

ARAMA isimli sayfanızın A2 hücresine yazacağınız kelimeyi, diğer çalışma sayfalarında A sütununda bulup getiren kodlar aşağıdadır.
Örnek dosya linki: https://s2.dosya.tc/server25/ura9cc/test.xlsm.html


Aşağıdaki kodları ARAMA isimli sayfanın içine ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Call test
End If
End Sub

Aşağıdaki kodları da bir modüle ekleyin.

Sub test()
Dim ws As Worksheet
Dim aran, yorum As String
Dim i, son, sonn As Long
aran = Sheets("ARAMA").Cells(2, 1)
Range("A4:A1000").Clear
For Each ws In Worksheets
If ws.Name <> "ARAMA" Then
ws.Select
son = [A10000].End(3).Row
For i = 1 To son
yorum = ws.Cells(i, "A").Value
If InStr(1, yorum, aran, vbTextCompare) > 0 Then
sonn = Sheets("ARAMA").[A10000].End(3).Row + 1
ws.Cells(i, "A").Copy Destination:=Sheets("ARAMA").Cells(sonn, 1)
End If
Next i
End If
Next ws
Sheets("ARAMA").Select
End Sub

 

[mustilem23]

Merhaba ,
Çalışmanız çok güzel elinize sağlık , rica etsem bir kaç düzenleme talep edebilir miyim müsaitliğiniz var ise ;
Ben kendime uyarlamak için bazen sayıda arayabiliyorum , birde sürekli aynı excel de değil açık olan tüm excel ve sayfalarında a ve r sütunları arasında 350 satıra kadar arama yaptıra bilmek mümkün müdür akabinde bu makroyu kısayol tuşu ile çalıştırıp PERSONEL.XLB Ye sabitlemeyi düşünüyorum bu şekilde güncelleme yapılabilmesi mümkün müdür acaba .

 

[mesuttasar]

Modül içine aşağıdaki kodları kopyalayın, O an halihazırda açık olan diğer excel çalışma kitaplarının her birinin sayfalarını kontrol ederek, aranan değer bulunursa, ana çalışma kitabınıza , kitap ismi, sayfa ismi, satır numarası ve sütun numarası gibi bilgileri getirebilirsiniz.

Sub test()
Dim ws As Worksheet
Dim aran, yorum As String
Dim i, son, sonn As Long
aran = Sheets("ARAMA").Cells(2, 1)
Range("A4:E1000").Clear
    For Each ws In Worksheets
        If ws.Name <> "ARAMA" Then
        ws.Select
        son = [A10000].End(3).Row
            For i = 1 To son
            yorum = ws.Cells(i, "A").Value
                If InStr(1, yorum, aran, vbTextCompare) > 0 Then
                sonn = Sheets("ARAMA").[A10000].End(3).Row + 1
                ws.Cells(i, "A").Copy Destination:=Sheets("ARAMA").Cells(sonn, 1)
                End If
            Next i
        End If
    Next ws
Sheets("ARAMA").Select

Dim wb As Workbook
Dim wsd As Worksheet
Dim hucre As Range
Dim j, k As Integer
Dim sutun As String

For Each wb In Application.Workbooks
    If wb.Name <> ThisWorkbook.Name Then
    wb.Activate
        For Each wsd In Worksheets
        wsd.Select
            For Each hucre In Range("A1:R350")
                If InStr(1, hucre, aran, vbTextCompare) > 0 Then
                j = hucre.Row
                k = hucre.Column
                sutun = Split(hucre.Address, "$")(1)
                ThisWorkbook.Activate
                sonn = Sheets("ARAMA").[A100000].End(3).Row + 1
                Sheets("ARAMA").Cells(sonn, 1) = hucre.Text
                Sheets("ARAMA").Cells(sonn, 2) = wb.Name
                Sheets("ARAMA").Cells(sonn, 3) = wsd.Name
                Sheets("ARAMA").Cells(sonn, 4) = j
                Sheets("ARAMA").Cells(sonn, 5) = sutun
                wb.Activate
                End If
            Next hucre
        Next wsd
    End If
Next wb
ThisWorkbook.Activate
End Sub

 

[Korhan Ayhan]

@ttb,

Profilinizde Ofis 365 Türkçe yazıyor. Bu sebeple paylaştığınız formülü Türkçe'ye çevirip kullanabiliyor olmanız gerekir.

 

[ttb]

@ttb,

Profilinizde Ofis 365 Türkçe yazıyor. Bu sebeple paylaştığınız formülü Türkçe'ye çevirip kullanabiliyor olmanız gerekir.

Merhaba, şahsi bilgisayarımda Office 365 mevcut; ancak iş yeride 2016 kullanılıyor. İlginiz için çok teşekür ederim

 

[ttb]

Merhaba, yanıtları için herkese teşekkür ederim. Hepsini denedim, bir şekilde (muhtemelen ben beceremediğim için) ufak hatalar aldım. O nedenle talebimi daraltıp bir örnekle iletmek isterim.
Ekli örnekte ARAMA sheetindeki B3 hücresine anahtar kelime yazıp (örneğin "bağımsız") ara butonuna basıldığında, Sheet1'deki C sütununda arama yapıp, anahtar kelimeyi bulduğunda hem ilgili kelimenin geçtiği Sheet1 C hücresini hem de anahtar kelimenin bulunduğu C hücresinin yanındaki B hücresini listelesin istiyorum.
Tablo üzerinden yardımcı olabilirseniz memnun olurum.
Şimdiden teşekkürler.

 

[ttb]

Modül içine aşağıdaki kodları kopyalayın, O an halihazırda açık olan diğer excel çalışma kitaplarının her birinin sayfalarını kontrol ederek, aranan değer bulunursa, ana çalışma kitabınıza , kitap ismi, sayfa ismi, satır numarası ve sütun numarası gibi bilgileri getirebilirsiniz.

Sub test()
Dim ws As Worksheet
Dim aran, yorum As String
Dim i, son, sonn As Long
aran = Sheets("ARAMA").Cells(2, 1)
Range("A4:E1000").Clear
    For Each ws In Worksheets
        If ws.Name <> "ARAMA" Then
        ws.Select
        son = [A10000].End(3).Row
            For i = 1 To son
            yorum = ws.Cells(i, "A").Value
                If InStr(1, yorum, aran, vbTextCompare) > 0 Then
                sonn = Sheets("ARAMA").[A10000].End(3).Row + 1
                ws.Cells(i, "A").Copy Destination:=Sheets("ARAMA").Cells(sonn, 1)
                End If
            Next i
        End If
    Next ws
Sheets("ARAMA").Select

Dim wb As Workbook
Dim wsd As Worksheet
Dim hucre As Range
Dim j, k As Integer
Dim sutun As String

For Each wb In Application.Workbooks
    If wb.Name <> ThisWorkbook.Name Then
    wb.Activate
        For Each wsd In Worksheets
        wsd.Select
            For Each hucre In Range("A1:R350")
                If InStr(1, hucre, aran, vbTextCompare) > 0 Then
                j = hucre.Row
                k = hucre.Column
                sutun = Split(hucre.Address, "$")(1)
                ThisWorkbook.Activate
                sonn = Sheets("ARAMA").[A100000].End(3).Row + 1
                Sheets("ARAMA").Cells(sonn, 1) = hucre.Text
                Sheets("ARAMA").Cells(sonn, 2) = wb.Name
                Sheets("ARAMA").Cells(sonn, 3) = wsd.Name
                Sheets("ARAMA").Cells(sonn, 4) = j
                Sheets("ARAMA").Cells(sonn, 5) = sutun
                wb.Activate
                End If
            Next hucre
        Next wsd
    End If
Next wb
ThisWorkbook.Activate
End Sub

Merhaba, bir örnek dosya ekledim en alta. O örnek üzerinden yardımcı olabilir misiniz rica etsem? Teşekkürler.

 

[mesuttasar]

Dosyayı upload sitesi üzerinden paylaşabilir misiniz?

 

[mesuttasar]

Dosyayı upload etmişsiniz indirip baktım ama bu dosya üzerinde ne yapmak istediğinizi anlamadım, ARAMA adlı bir sheet yok, anahtar kelimeyi yazacağınız yer neresi, bunu yazdıktan sonra hangi bilgileri hangi sayfalardan almak istiyorsunuz anlamadım, biraz daha açıklayıcı olursa yardımcı olmak isterim.

 

[ttb]

Dosyayı upload etmişsiniz indirip baktım ama bu dosya üzerinde ne yapmak istediğinizi anlamadım, ARAMA adlı bir sheet yok, anahtar kelimeyi yazacağınız yer neresi, bunu yazdıktan sonra hangi bilgileri hangi sayfalardan almak istiyorsunuz anlamadım, biraz daha açıklayıcı olursa yardımcı olmak isterim.

Çok pardon, yanlış excel eklemişim. Yarın tekrar ekleyip size bilgi veririm. İlginiz için çok teşekkür ederim.

 

[ttb]

Dosyayı upload etmişsiniz indirip baktım ama bu dosya üzerinde ne yapmak istediğinizi anlamadım, ARAMA adlı bir sheet yok, anahtar kelimeyi yazacağınız yer neresi, bunu yazdıktan sonra hangi bilgileri hangi sayfalardan almak istiyorsunuz anlamadım, biraz daha açıklayıcı olursa yardımcı olmak isterim.

Merhaba, şimdi tekrar ekledim. Teşekkürler.

 

[Necdet]

Merhaba,
Deneyiniz

 

[ttb]

Merhaba,
Deneyiniz

Size ve yardımcı olan herkese çok teşekkürler.