• DİKKAT

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

Aranan Verinin Bulunduğu Tüm Hücrelerin Adreslerini Bulmak

B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba arkadaşlar. Bir veriden farklı sayfalarda bulunmaktadır. Sayfalarda bulunan verileri ctrl F ile aratıyorum. Ctrl F yapınca ekrana gelen pencerede Sayfa ve Hücre bölümü altında yazılı olan bilgileri hücrelere yazdırmak mümkün mü ? Örnek dosyanın linki : http://www.mediafire.com/download/6aog8cz68tim6y8/_SORU.xlsm
 
Son düzenleme:
Merhaba,
Buradaki çalışma işinize yarar mı?
 
Teşekkürler sayın dEdE. Kodun buraya kopyalanması mümkün mü acaba ?
 
Merhaba,
Kodlar aşağıda ama, UserForm üzerinde çalıştığı için linkteki dosyayı incelemenizi öneririm.
Kod: 
Dim Bulunacak As String

Sub Ara()
If Bulunacak = "" Then Exit Sub
For i = 1 To Worksheets.Count
If OptionButton1.Value = False Then
    Set Aranan = Sheets(i).Cells.Find(Bulunacak, , xlValues, xlPart)
    Else
    Set Aranan = Sheets(i).Cells.Find(Bulunacak, , xlValues, xlWhole)
End If
    If Not Aranan Is Nothing Then
        adres = Aranan.Address
        Do
            ListBox1.AddItem
            ListBox1.Column(0, ListBox1.ListCount - 1) = Sheets(i).Name
            ListBox1.Column(1, ListBox1.ListCount - 1) = Aranan.Address
            Set Aranan = Sheets(i).Cells.FindNext(Aranan)
        Loop While Not Aranan Is Nothing And Aranan.Address <> adres
    End If
    Label1.Caption = "Aranan  " & Bulunacak
Next i
If adres = "" Then Label1.Caption = Bulunacak & "  bu dosyada yok."

End Sub

Private Sub CommandButton2_Click()
Label1.Caption = ""
ListBox1.Clear
TextBox1.Text = ""
If ActiveCell.Value = "" Then MsgBox "Lütfen aradığınız sözcüğü içeren hücreyi seçiniz.", , "UYARI": Exit Sub
Bulunacak = ActiveCell.Value
Ara
End Sub

Private Sub CommandButton3_Click()
Label1.Caption = ""
ListBox1.Clear
If TextBox1.Text = "" Then MsgBox "Lütfen aradığınız sözcüğü yazınız.", , "UYARI": TextBox1.SetFocus: Exit Sub
Bulunacak = TextBox1.Text
Ara
TextBox1.Text = ""
End Sub

Private Sub ListBox1_Click()
    Sheets(ListBox1.Column(0)).Select
    Range(ListBox1.Column(1)).Select
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub
 
dEdE' Alıntı:
Merhaba,
Kodlar aşağıda ama, UserForm üzerinde çalıştığı için linkteki dosyayı incelemenizi öneririm.
Kod: 
Dim Bulunacak As String

Sub Ara()
If Bulunacak = "" Then Exit Sub
For i = 1 To Worksheets.Count
If OptionButton1.Value = False Then
    Set Aranan = Sheets(i).Cells.Find(Bulunacak, , xlValues, xlPart)
    Else
    Set Aranan = Sheets(i).Cells.Find(Bulunacak, , xlValues, xlWhole)
End If
    If Not Aranan Is Nothing Then
        adres = Aranan.Address
        Do
            ListBox1.AddItem
            ListBox1.Column(0, ListBox1.ListCount - 1) = Sheets(i).Name
            ListBox1.Column(1, ListBox1.ListCount - 1) = Aranan.Address
            Set Aranan = Sheets(i).Cells.FindNext(Aranan)
        Loop While Not Aranan Is Nothing And Aranan.Address <> adres
    End If
    Label1.Caption = "Aranan  " & Bulunacak
Next i
If adres = "" Then Label1.Caption = Bulunacak & "  bu dosyada yok."

End Sub

Private Sub CommandButton2_Click()
Label1.Caption = ""
ListBox1.Clear
TextBox1.Text = ""
If ActiveCell.Value = "" Then MsgBox "Lütfen aradığınız sözcüğü içeren hücreyi seçiniz.", , "UYARI": Exit Sub
Bulunacak = ActiveCell.Value
Ara
End Sub

Private Sub CommandButton3_Click()
Label1.Caption = ""
ListBox1.Clear
If TextBox1.Text = "" Then MsgBox "Lütfen aradığınız sözcüğü yazınız.", , "UYARI": TextBox1.SetFocus: Exit Sub
Bulunacak = TextBox1.Text
Ara
TextBox1.Text = ""
End Sub

Private Sub ListBox1_Click()
    Sheets(ListBox1.Column(0)).Select
    Range(ListBox1.Column(1)).Select
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub
Genişletmek için tıkla ...



selamlar hocam
buna benzer bir sorum var ;
örnek dosyada açıklama yaptım..

bir sütunda liste halindeki arama kriterim olan kelimeleri,
diğer sütundaki liste halideki cümlelerin içinde arayıp,
bulunan hücre adresini ve karşısındaki değeri getirmek istiyorum.
makro ile nasıl yapılabilir?
forumda bulamadım
yardımlarınız için teşekkürler.

https://ccccferhatmutlu.sharefile.com/d-sf948eb9555d4ae5b
 
çok teşekkür ediyorum sayın dEdE. ama bu kod işime yaramadı. Ctrl F ile bulunan sonuçları excele yazdıracak bir kod işimi görürdü.
 
Merhaba arkadaşlar. Bir veriden farklı sayfalarda bulunmaktadır. Sayfalarda bulunan verileri ctrl F ile aratıyorum. Ctrl F yapınca ekrana gelen pencerede Sayfa ve Hücre bölümü altında yazılı olan bilgileri hücrelere yazdırmak mümkün olur mu ?
 
Son düzenleme:
Merhaba arkadaşlar. Bir veriden farklı sayfalarda bulunmaktadır. Sayfalarda bulunan verileri ctrl F ile aratıyorum. Ctrl F yapınca ekrana gelen pencerede Sayfa ve Hücre bölümü altında yazılı olan bilgileri hücrelere yazdırmak mümkün müdür ?
 
Merhaba,
Aşağıdaki kodları örnek dosyanızda bir modüle yapıştırıp dener misiniz?
Aradığınız sözcüğü içeren hücreyi seçip kodu çalıştırınız.
Kod: 
Sub Ara()
Bulunacak = ActiveCell.Value
If Bulunacak = "" Then
    MsgBox "Lütfen Aradiğınız Sözcüğü İçeren Hücreyi Seçiniz..."
    Exit Sub
End If
    Set Aranan = Range("I:I").Find(Bulunacak, , xlValues, xlPart)

    If Not Aranan Is Nothing Then
        adres = Aranan.Address
        Do
            PAdres = PAdres + Range(Aranan.Address).Offset(0, -1).Address + ","
            Parti = Parti + Range(Aranan.Address).Offset(0, 1).Value + ","
            Set Aranan = Range("I:I").FindNext(Aranan)
        Loop While Not Aranan Is Nothing And Aranan.Address <> adres
    End If

If adres = "" Then
    MsgBox Bulunacak & "  bu sayfada yok."
    Exit Sub
End If
    Range("F3") = PAdres
    Range("E3") = Parti
    Range("F3").Replace What:="$", Replacement:=""
End Sub
 
İlginize çok teşekkür ediyorum sayın dEdE. aşağıdaki satırda hata mesajı verdi :

Parti = Parti + Range(Aranan.Address).Offset(0, 1).Value + ","
 
Alternatif olsun
Kod: 
Sub Makro6()
Aranan = "rpu"
For e = 1 To Sheets.Count
Sheets(e).Select
say = Application.CountIf(Cells, "*" & Aranan & "*")
If say <> 0 Then
If say > 0 Then
    Cells.Find(What:="rpu", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        For i = 1 To say
    Cells.FindNext(After:=ActiveCell).Activate
     MsgBox ActiveSheet.Name & " " &  ActiveCell.Address
  Next
  End If
    End If
    Next
End Sub
 
Son düzenleme:
Sayın alicimri, çok cömertsiniz, çok teşekkür ediyorum. Mesaj yerine DATA sayfası A1 hücresinde aşağıya doğru sayfa adı dahil hücre adresleri yazılabilir mi ?
 
Kolay gelsin
Kod: 
Sub Makro6()
Aranan = Sheets("DATA").Range("D1")
For e = 1 To Sheets.Count
If Sheets(e).Name <> "DATA" Then
Sheets(e).Select
say = Application.CountIf(Range("D4:F20"), "*" & Aranan & "*")
If say <> 0 Then
If say > 0 Then
  ss = Range("D4:F20").Find(What:=Aranan , After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        For i = 1 To say
    Range("D4:F20").FindNext(After:=ActiveCell).Activate
    Sheets("DATA").Range("A" & Sheets("DATA").Range("A65536").End(3).Row + 1).Value = ActiveSheet.Name & " " & ActiveCell.Address
  Next
  End If
    End If
    End If
    Next
End Sub
 
Son düzenleme:
Arama kriterini yani "ss = Cells.Find(What:="rpu"," kısmını DATA sayfasında D1 hücresinden alması için kodu nasıl değiştirmem gerekir acaba ? veya bu mümkün müdür ?
 
Sayın alicimri, çok ama çok teşekkür ediyorum. Mükemmel ötesi oldu. Sağolun, varolun.
 
Merhaba,
Kodların hata verdiğini yazmışsınız.Örnek dosyanız üzerinde hata vermiyor.
Hoşçakalın.
 

Ekli dosyalar

İlginize teşekkür ediyorum dEdE. Neden hata verdi bilemiyorum, belki farklı ofis paketlerinden kaynaklanıyor olabilir. Kodu muhafaza edeceğim, başka bir PC de deneyeceğim. Çok teşekkür ediyorum.
 
dEdE' Alıntı:
Merhaba,
Kodların hata verdiğini yazmışsınız.Örnek dosyanız üzerinde hata vermiyor.
Hoşçakalın.
Genişletmek için tıkla ...

hocam kodlar hata vermiyor. tam istediğim gibi elinize sağlık,
ama ;

sonuç sadece E3 ve F3 hücresinde çıkıyor
(örnek dosyada oraya sadece açıklama yapmak amacıyla yazmıştım
zaten örnek dosyada sonuçlar C sütununda)

sonuçlar E SÜTUNU ve F sütununda olacak şekilde (veya C D sütunları farketmez);

tek tek tıklayıp aramak yerine

For i = 1 To 25000
Cells(i, 3).value = Bulunacak

gibi ; (vba kodlama bilmiyorum

makro çalışınca arama kriteri olan B sütunundaki 25000 satırı sorgulayıp ;
her arama kriterinin sonucunu karşısına E ve F sütununa nasıl alabiliriz?

hocam ikinci bir sorun örnek olarak;

"ocak ithalat" kelimesini aramak istediğimizde
"2016 OCAK ayı itibariyle İTHALAT rakamları" cümlesinde arada başka kelimeler olsada içinde "ocak ithalat" kelimeleri geçtiğinden bu cümlenin olduğu hücre adresini ve karşılığını alabilirmiyiz.

yardımlarınız için teşekkürler

(benzer bir konu olduğundan yeni konu açmadım bu konu başlığı altına yazdım.. kodların hata verdiğini sayın serdarokan yazmış "Aranan Verinin Bulunduğu Tüm Hücrelerin Adreslerini Bulmak" konusunda.
benim gönderdiğim örnek dosya "cümle içinde arama".)
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst