• DİKKAT

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

Belirttiğim kelimeleri içeren kayıtlar

B

burakond

Katılım
8 Kasım 2014
Mesajlar
9
Excel Vers. ve Dili
Excel 2013 Türkçe
Merhaba. 100 000 tane kaydım var. Bu kayıtlar içinde mesela abc, xyz, 123, 345, 567 geçen satırları göstermesini istiyorum. 1 şart ekliyorum 2 şart ekliyorum 3. kelimeyi eklediğimde yani "123" en son eklediğim kelime aralığını arıyor. 2.den sonra sıkıntı var. Kullandığım kod aşağıda. Nasıl yapacağız?

Ayşe yada Fatma aramasın içinde a yada b geçen kayıtları arasın istiyorum.

Kod: 
ActiveSheet.Range("A2", ActiveSheet.Range("A2").End(xlDown)).AutoFilter Field:=1, Criteria1:=Array( _
"=*abc*", "=*xyz*", "=*123*")
 
Bilen yok sanırım :(

1000 tane kayıttan içinde aaaa olanları bbbb olanları listelesin sadece istiyorum. Ayıklama işlemi yani. Ama şartlar çok 100 tane falan kelime girecegim manuel olarak.
 
Merhaba bende ödevim için böyle bir çalışma yapmalıyım dosyayı gönderebilmeniz mümkün mü
acaba?
 
Corvinus' Alıntı:
Merhaba bende ödevim için böyle bir çalışma yapmalıyım dosyayı gönderebilmeniz mümkün mü
acaba?
Genişletmek için tıkla ...

elimde 1000 lerce veri var diyelim. istediğim kategorilerdekileri, kelimelerdekileri listelemesini istiyorum.
 
Son düzenleme:
Bul Yaz

Ekli dosyayı inceleyiniz
Kod: 
Sub bulYaz()
Set S1 = Sheets("Aranan")
Set S2 = Sheets("Data")
son = S1.[A65536].End(3).Row
For i = 1 To son
    Set BUL = S2.Cells.Find(S1.Cells(i, 1).Value, , , xlPart, , xlNext)
    If Not BUL Is Nothing Then
            ADRES = BUL.Address
        Do

        S2.Cells(BUL.Row, 2).Value = S1.Cells(i, 1).Value
        Set BUL = S2.Cells.FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
Next
MsgBox "İşlem Tamamlandı..."
End Sub
 

Ekli dosyalar

tahsinanarat' Alıntı:
Ekli dosyayı inceleyiniz
Kod: 
Sub bulYaz()
Set S1 = Sheets("Aranan")
Set S2 = Sheets("Data")
son = S1.[A65536].End(3).Row
For i = 1 To son
    Set BUL = S2.Cells.Find(S1.Cells(i, 1).Value, , , xlPart, , xlNext)
    If Not BUL Is Nothing Then
            ADRES = BUL.Address
        Do

        S2.Cells(BUL.Row, 2).Value = S1.Cells(i, 1).Value
        Set BUL = S2.Cells.FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
Next
MsgBox "İşlem Tamamlandı..."
End Sub
Genişletmek için tıkla ...

teşekkürler inceleyeceğim. dosya.tc yüklermisiniz indiremiyorum :(
 
Aranan sayfasının kod bölümüne yapıştırın, A1 hücresinde yazılı kelimenin geçtiği tüm sayfaların A sütununda arama yapıp bulunanların b sütununa * işareti koyar

Kod: 
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 <> "Aranan" Then
            'Set Bul = Sayfa.Cells.Find(Target, LookAt:=xlWhole) 'eşleşen değerleri bulur
            Set Bul = Sayfa.Cells.Find(Target, LookAt:=xlPart)  'içinde geçen değerleri bulur
            If Not Bul Is Nothing Then
            Sayfa.Range("B:B").ClearContents
            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 & " kelime bulunamamıştır !", vbExclamation, "Dikkat !"
End Sub
 
Son düzenleme:
Data sayfasının A sütununda arama yapar bulduklarını Bulunanlar Sayfasına Aktarır, (içerir arama yapacaksanız kelimenin başına ve sonuna * koyunuz)
Kod: 
Sub Bul_Yaz2()

    Dim S2 As Worksheet, sor As String, c As Range, Adr As String, sat As Long

    Set S2 = Sheets("Bulunanlar")
    sor = Application.InputBox("Aranan Kelimeyi Yazın", "Arama")

    If sor = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    Sheets("Data").Select
    S2.Rows("2:" & Rows.Count).Clear

    sat = 2
    With Range("A:A")
        Set c = .Find(sor, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Rows(c.Row).Copy S2.Cells(sat, "A")
                sat = sat + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With

    S2.Select
    Application.ScreenUpdating = True

End Sub
 
Denedim çok güzel olmuş elinize sağlık. Şöyle birşey yapamam mı. Verdiğiniz makroda tek tek giriliyor veriler.
100 tane kelimeyi bir yerde yazıp sırayla bu kelimeleri aratıp diğer sayfaya atamaz mı

B sütununda da kelimeler olsun mesela..
 
Son düzenleme:
Aynı sayfanın f sütununda listeler, E1 hücresine yazacağınız kelimeyi A sütununda arama yapıp F sütununda alt alta listeler, aşağıdaki kodu Data sayfasının kod bölümüne yazın
Kod: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Satır As Long, Bul As Range, Adres As String
    If Intersect(Target, [E1]) Is Nothing Then Exit Sub
    If Target <> Empty Then
    [F2:G65536].ClearContents
    Satır = 2
    Set Bul = [A:A].Find([E1], LookAt:=xlPart)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
    Do
    Cells(Satır, "F") = Cells(Bul.Row, "A").Value
    Satır = Satır + 1
    Set Bul = [A:A].FindNext(Bul)
    Loop While Not Bul Is Nothing And Bul.Address <> Adres
    Set Bul = Nothing
    End If
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Else
    [F2:G65536].ClearContents
    End If
End Sub
 
çok harika oldu gerçekten elinize sağlık. excel hakkında hiçbir bilgim olmadığı halde çok yol katettim sayenizde.
 
Bu yazdığım kodların hepsi bu siteden temin edilmiştir, yani hepsi burada kullanılan kodlardandır. İşinize yaramasına sevindim.
 
tahsinanarat' Alıntı:
Bu yazdığım kodların hepsi bu siteden temin edilmiştir, yani hepsi burada kullanılan kodlardandır. İşinize yaramasına sevindim.
Genişletmek için tıkla ...

2. sayfada a sütununa aranmasını istediğimiz kelimeleri yazmıştık.
2. sayfada b sütununa gözardı edilmesi, yani a sütunundaki kelimeyi içersede b yide içeriyorsa görünmemesini nasıl sağlarız.

guzelyemek kelimemiz var mesela. a sütununda yemek kelimesine göre bu kaydı aldı, ama ben guzel kelimesini istemiyorum alsada yazdırmasın elesin.
 
Son düzenleme:
bulyaz makrosuna
S2.[b2:b10000].Clear
satırını ilave ettim, data sayfasındaki b sütununu sildirir
Son eklediğim linkte mevcuttur.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst