makro ile arama yapmak

[jakal]

Arkdaşlar yanlış yere konu açmış olabilirim kusura bakmayın konu ile sitede arama yaptım ancak tatmin edici bi cevap bulmadım sorum şu excelde 4 adet çalışma sayfasını 5 inci olarak açtığım çalışma sayfasında google gibi bi açık alan oluşturarak diğer çalışma sayfalarında arama yapmak bulanan sonucun aşağıda görünmesi şeklinde bi makro mümkün mü böle bi kod yazıla bilirmi? şimdiden teşekkürler

 

[zafer]

Merhaba

Ekli dosyayı inceleyiniz.ARAMA sayfasında A1 hücresine arama yapmak istediğiniz metni girin. LISTELE düğmesini çalıştırınız.Sayfa sayısı önemli değil istediğiniz kadar sayfa açabilirsiniz.

Sadece sizi aydınlatması açısından inceleyiniz.
Örnek dosya ekleyip orada isteklerinizi açıklarsanız daha iyi sonuç alabilirsiniz

 

[Mustafa MUTLU]

Eline sağlık güzel olmuş
Bir eksiği BÜYÜK & küçük Harf eşleşmemesi..
Onuda eklersen daha güzel olur.

 

[jakal]

Teşekkür ederim kardeşim emeğine sağlık anlatmak istediğim gibi olmuş çok teşekkür ederim

 

[Ömer]

Arkdaşlar yanlış yere konu açmış olabilirim kusura bakmayın konu ile sitede arama yaptım ancak tatmin edici bi cevap bulmadım sorum şu excelde 4 adet çalışma sayfasını 5 inci olarak açtığım çalışma sayfasında google gibi bi açık alan oluşturarak diğer çalışma sayfalarında arama yapmak bulanan sonucun aşağıda görünmesi şeklinde bi makro mümkün mü böle bi kod yazıla bilirmi? şimdiden teşekkürler

Merhaba,

Alternatif olsun.

Arama adlı sayfanın A1 hücresine girilen değeri tüm sayfalarda arar, bulduğu hücrelerin adreslerini Arama sayfası A2 den başlayarak link vererek ( köprü ) yazar. Linklere tıklayarak bulunan değerlere gidebilirsiniz.

Eğer arama adı sayfanın içinde de arama yapmak istiyorsanız yeşil renkli iki satırı silersiniz yada başına ' tek tırnak işareti koyarsınız.

Sub BulListele()
 
    Dim c As Range, Adr As Variant, sat As Long, sonhcr As Range
    Dim i As Integer, adres As String
    Sheets("[COLOR=red][B]Arama[/B][/COLOR]").Select
    If Range("[COLOR=blue][B]A1[/B][/COLOR]") = "" Then MsgBox "Aranacak Değeri Girin": Exit Sub
 
    sat = [B][COLOR=darkgreen]2[/COLOR][/B]: Range("[COLOR=darkred][B]A[/B][/COLOR]" & sat, "[COLOR=darkred][B]A[/B][/COLOR]" & Rows.Count).ClearContents
    For i = 1 To Worksheets.Count
      [COLOR=darkgreen]If Not Sheets(i).Name = "Arama" Then[/COLOR]
        With Sheets(i).Cells
          Set sonhcr = .Cells(.Cells.Count)
          Set c = .Find(Range("[B][COLOR=blue]A1[/COLOR][/B]"), sonhcr, xlValues, xlWhole)
            If Not c Is Nothing Then
              Adr = c.Address
                Do
                  adres = Sheets(i).Name & "!" & c.Address
                  ActiveSheet.Hyperlinks.Add Cells(sat, "[COLOR=darkred][B]A[/B][/COLOR]"), "", adres, adres
                  sat = sat + 1
                Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
      [COLOR=darkgreen]End If[/COLOR]
    Next i
 
    Set sonhcr = Nothing: Set c = Nothing
    MsgBox "Listeleme Tamam", , "excel.web.tr"
 
End Sub

.

 

[jakal]

Ömer bey kardeşim emeğine sağlık teşekkür ederim gerçekten hoş bi arama penceresi olmuş bi sorum olucak ben bu makroyu başka bi excel sayfasında aynı şekilde kullanmak istediğimde ara butonunu çalıştıramıyorum yardımcı olursanız

 

[Ömer]

Kullanamıyorumdan kastınız nedir.

Butonu çalıştırdığınız sayfasının adını kırmızı ile işaretlemiştim. Sayfa adından sorun yoksa, sorun yaşadığınız dosyayı eklermisiniz.

.

 

[jakal]

ömer bey sorun benden kaynaklanıyomuş kusura bakmayın ufak detayı gözden kaçırmışım tekrar teşekkürler

 

[ametal]

merhaba umarım dogru soruyu soruyorumdur, Bu arama motorunu sheetler içinde değil de farklı exel dosyalarının içinde veri aratmak için nasıl kullanabilirim?

 

[I-TECH-INN]

Merhaba,

Alternatif olsun.

Arama adlı sayfanın A1 hücresine girilen değeri tüm sayfalarda arar, bulduğu hücrelerin adreslerini Arama sayfası A2 den başlayarak link vererek ( köprü ) yazar. Linklere tıklayarak bulunan değerlere gidebilirsiniz.

Eğer arama adı sayfanın içinde de arama yapmak istiyorsanız yeşil renkli iki satırı silersiniz yada başına ' tek tırnak işareti koyarsınız.

Sub BulListele()
 
    Dim c As Range, Adr As Variant, sat As Long, sonhcr As Range
    Dim i As Integer, adres As String
    Sheets("[COLOR=red][B]Arama[/B][/COLOR]").Select
    If Range("[COLOR=blue][B]A1[/B][/COLOR]") = "" Then MsgBox "Aranacak Değeri Girin": Exit Sub
 
    sat = [B][COLOR=darkgreen]2[/COLOR][/B]: Range("[COLOR=darkred][B]A[/B][/COLOR]" & sat, "[COLOR=darkred][B]A[/B][/COLOR]" & Rows.Count).ClearContents
    For i = 1 To Worksheets.Count
      [COLOR=darkgreen]If Not Sheets(i).Name = "Arama" Then[/COLOR]
        With Sheets(i).Cells
          Set sonhcr = .Cells(.Cells.Count)
          Set c = .Find(Range("[B][COLOR=blue]A1[/COLOR][/B]"), sonhcr, xlValues, xlWhole)
            If Not c Is Nothing Then
              Adr = c.Address
                Do
                  adres = Sheets(i).Name & "!" & c.Address
                  ActiveSheet.Hyperlinks.Add Cells(sat, "[COLOR=darkred][B]A[/B][/COLOR]"), "", adres, adres
                  sat = sat + 1
                Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
      [COLOR=darkgreen]End If[/COLOR]
    Next i
 
    Set sonhcr = Nothing: Set c = Nothing
    MsgBox "Listeleme Tamam", , "excel.web.tr"
 
End Sub

.

Merhabalar

İlgili kodu "Arama" İsimli sayfama eklediğimde ve A1 hücresine yazılanı aratmak istediğimde "Overflow" hatası almaktayım.

F8 ile adım adım gittiğimde ise,
"Set sonhcr = .Cells(.Cells.Count)"
Satırında Overflow vermekte.

Sayfamın yapısı; 29 adet Çalışma sayfası var. Ancak her birisinin adı farklı. "Sivas, Ankara,İzmir" vb..

Acaba bu kod, sayfa isimlerinden dolayı mı çalışmamakta anlayamadım.

Yanıtlarınızı beklemekteyim

Saygılarımla

 

[rkizilarslan]

Sorgu-kaynak

"Sorgu" sayfasında b2 hücresine yazdığımızı, düşeyara formülü yada makro ile "kaynak" sayfasında arama yapacak ("Kaynak" sayfası içinde aynı kişiye ait birden fazla satırda bilgi mevcut.) ve bulunan bilgileri "sorgu" sayfasına yazacak. Dosya içerisine açıklama yazdım, ilginize teşekkürler.

 

[Orion1]

Dosyanız ektedir.

Sub sorgula_aktar_59()
Dim sh As Worksheet
Sheets("sorgu").Select
Application.ScreenUpdating = False
Range("B5:I" & Rows.Count).ClearContents
If Range("B2").Value = "" Then
    MsgBox "Sorgu yapmak için B2 hücresine bir numara(sayısal) girmelisiniz!!", vbCritical, "U Y A R I"
    Application.ScreenUpdating = True
    Range("B2").Select
    Exit Sub
End If
Set sh = Sheets("kaynak")
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=1, Criteria1:=Range("B2").Value
sh.Range("A1").CurrentRegion.Copy Range("B4")
sh.Range("A1").AutoFilter
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
Range("B2").Select
End Sub

 

[rkizilarslan]

elinize emeğinize sağlık, teşekkür ederim.

 

[Ömer]

Merhabalar

İlgili kodu "Arama" İsimli sayfama eklediğimde ve A1 hücresine yazılanı aratmak istediğimde "Overflow" hatası almaktayım.

F8 ile adım adım gittiğimde ise,
"Set sonhcr = .Cells(.Cells.Count)"
Satırında Overflow vermekte.

Kodları sayfa bölümüne değilse module eklediğinizde aynı hatayı alıyormusunuz.

Hata aldığınız dosyayı eklermisiniz.

.

 

[rkizilarslan]

Dosyanız ektedir.

Sub sorgula_aktar_59()
Dim sh As Worksheet
Sheets("sorgu").Select
Application.ScreenUpdating = False
Range("B5:I" & Rows.Count).ClearContents
If Range("B2").Value = "" Then
    MsgBox "Sorgu yapmak için B2 hücresine bir numara(sayısal) girmelisiniz!!", vbCritical, "U Y A R I"
    Application.ScreenUpdating = True
    Range("B2").Select
    Exit Sub
End If
Set sh = Sheets("kaynak")
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=1, Criteria1:=Range("B2").Value
sh.Range("A1").CurrentRegion.Copy Range("B4")
sh.Range("A1").AutoFilter
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
Range("B2").Select
End Sub

hocam hücreye aranacak rakamı yazdıktan sonra, başka bir hücre seçmeden yada enter yapmadan arama yapmıyor.

kaynak sayfasındaki bilgilere ulaşımı engellemek için ve şeklini korumak için koruma koyunca ve makroya koruma koyunca çalışmıyor.

ve bu aramayı iletişim kutusuna numara yazarak arayabilirmiyiz acaba.

 

[I-TECH-INN]

Kodları sayfa bölümüne değilse module eklediğinizde aynı hatayı alıyormusunuz.

Hata aldığınız dosyayı eklermisiniz.

.

Merhaba Ömer Bey;

Sitede, xlsm eklentiye izin verilmediği için maalesef makro eklenmiş halini veremiyorum.

2007 Office'de xlsx olarak makro içeren dosya kaydetmeyi henüz başaramadım.

Not: Sayfayı bu mesajı yazarken aklıma geldiği için, Başka bir dosyayı XLS formatında kaydedip denedim. Bu sefer çalıştı. Ancak aynı dosya xlsm olunca yine çalışmıyor.

Benim uygulama yapmaya çalıştığım dosya ise (ki basit birşey zaten) iki formatta da overflow hatası vermekte.

Peki sorumu şöyle değiştirsem;

xlsm formatındaki 2007 Makro içeren excel sayfasında nasıl arama işlemini aktif edebiliriz?

Saygılarımla
Aytekin OLCAY

 

[Ömer]

Hata veren satırda;

Set sonhcr = .Cells(.Cells.Count)

Kırmızı işaretli bölümü Rows olarak değiştirerek deneyiniz.

.

 

[rkizilarslan]

hocam diğer çalışmadan hariç olarak, gönderdiğim dosyayı inceleyebilirmisiniz, teşekkürler.

 

[I-TECH-INN]

Hata veren satırda;

Set sonhcr = .Cells(.Cells.Count)

Kırmızı işaretli bölümü Rows olarak değiştirerek deneyiniz.

.

Ömer Bey merhaba;

"Listeleme Tamam" mesajı veriyor ama ekrana hiç bir yazı vs.. basmıyor.

Bilginize

 

[Orion1]

hocam diğer çalışmadan hariç olarak, gönderdiğim dosyayı inceleyebilirmisiniz, teşekkürler.

Yeni bir konu açıp oradan devam edin.
Siz başkasının konu başlığını işgal etmişsiniz.