• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan ttb
  • Başlangıç tarihi Başlangıç tarihi
ttb

ttb

Katılım
13 Kasım 2018
Mesajlar
50
Excel Vers. ve Dili
Office 365 Türkçe
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.
 
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.

Kod: 
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.

Kod: 
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
 
Son düzenleme:
  • Beğen
Reactions: ttb
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 .
 
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.

Kod: 
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
 
  • Beğen
Reactions: 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.
 
  • Beğen
Reactions: ttb
Korhan Ayhan' Alıntı:
@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.
Genişletmek için tıkla ...
Merhaba, şahsi bilgisayarımda Office 365 mevcut; ancak iş yeride 2016 kullanılıyor. İlginiz için çok teşekür ederim
 
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.
 
mesuttasar' Alıntı:
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.

Kod: 
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
Genişletmek için tıkla ...
Merhaba, bir örnek dosya ekledim en alta. O örnek üzerinden yardımcı olabilir misiniz rica etsem? Teşekkürler.
 
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.
 
mesuttasar' Alıntı:
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.
Genişletmek için tıkla ...
Çok pardon, yanlış excel eklemişim. Yarın tekrar ekleyip size bilgi veririm. İlginiz için çok teşekkür ederim.
 
mesuttasar' Alıntı:
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.
Genişletmek için tıkla ...
Merhaba, şimdi tekrar ekledim. Teşekkürler.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst