makro ile arama yapmak

jakal · 30 Eylül 2011

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 · 30 Eylül 2011

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 · 30 Eylül 2011

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 · 30 Eylül 2011

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

Ömer · 1 Ekim 2011

jakal' Alıntı:
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.

Kod:

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 · 3 Ekim 2011

Ö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 · 3 Ekim 2011

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 · 4 Ekim 2011

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

ametal · 11 Kasım 2011

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 · 22 Kasım 2011

Ömer' Alıntı:

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.

Kod:

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 · 23 Kasım 2011

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 · 23 Kasım 2011

Dosyanız ektedir.

Kod:

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 · 23 Kasım 2011

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

Ömer · 23 Kasım 2011

I-TECH-INN' Alıntı:
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 · 23 Kasım 2011

Orion1' Alıntı:

Dosyanız ektedir.

Kod:

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 · 23 Kasım 2011

Ömer' Alıntı:
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 · 23 Kasım 2011

Hata veren satırda;

Set sonhcr = .Cells(.Cells.Count)

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

.

rkizilarslan · 23 Kasım 2011

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

I-TECH-INN · 23 Kasım 2011

Ömer' Alıntı:
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 · 23 Kasım 2011

rkizilarslan' Alıntı:
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.

makro ile arama yapmak

jakal

zafer

Super Moderator

Ekli dosyalar

Mustafa MUTLU

Destek Ekibi

jakal

Ömer

Moderatör

Ekli dosyalar

jakal

Ömer

Moderatör

jakal

ametal

I-TECH-INN

rkizilarslan

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar

rkizilarslan

Ömer

Moderatör

rkizilarslan

I-TECH-INN

Ömer

Moderatör

rkizilarslan

Ekli dosyalar

I-TECH-INN

Orion1

Uzman