makro ile arama yapmak

[Ömer]

Ömer Bey merhaba;

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

Bilginize

2007 olmadığı için deneyemiyorum.
Kodları aşağıdakilerle değiştirerek deneyin. Diğer ölçütü iptal ettim, aramayı etkileyen bir ölçüt değildi. 2007 olan bilgisayarda de ben daha sonra denerim.

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

.

 

[I-TECH-INN]

Ömer Bey kolay gelsin,

Şuan verdiğiniz kod sorunsuz arama yapıyor.

Ancak şimdi de, Misal " 'XYZ'!A44 " olarak gelen sayfa linkini tıkladığımda, sayfaya gitmiyor. geçersiz başvuru diyor.

adres = "'" & Sheets(i).Name & "'!" & c.Address

şeklinde yapıp, " ' " koyduğumda da, sayfaya gidiyor ama hücreye gitmiyor maalesef.

Yardımlarınızı beklemekteyim

Saygılarımla

 

[Ömer]

#21 numaralı mesajı düzenledim. Yeniden denermisiniz.

 

[I-TECH-INN]

Ömer Bey tekrar kolay gelsin.

Öncelikle emekleriniz için teşekkür ederim. Kod çok sağlıklı çalışıyor.

Ancak kod sadece "Birebir eşlenik" sonuçlar çeviriyor. C#'daki gibi Contains (Excel'de InStr sanırım) kullanmayı denediğimde de başarılı olamadım.

Misal, Ali girdiğimde Ali X, Ali Y gibi, hücre içeriğinde girilen metin mevcutsa şeklinde çalışmasını nasıl sağlarız ?

Tam olarak anlatabildim mi bilmiyorum ama kısaca "Birebir eşleniyorsa" yerine "İçeriyor ise" şeklinde olmasını sağlamayı nasıl yaparız?

Tekrar teşekkür ederim, başınızı ağrıtıyorum özürlerimi kabul edin.

Saygılarımla
Aytekin

 

[Ömer]

Set c = .Find(Range("A1"), , xlValues, xlWhole)

üsteki satırı aşağıdaki gibi değiştirin.

Set c = .Find(Range("A1"), LookAt:=xlPart)

.

 

[flexelem]

Değerli arkadaşlar Merhaba,

Listeleme konusu ile ilgili sizden yardım beklentim var. Umarım yardımcı olabilirsiniz.

Elimde uzun yıllardır çalıştığım bir excel dosyam var.
Her yıl yeni bir sekme açıyorum ve o yılki girdileri yazıyorum.

Sizin listele makronuzla epey uğraştım ama neredeyse hiç bir çözüme ulaşamadım.

Yapmak istediğim şudur.

EK' te bir excel dosyam var.

Burada İsimler var ve altında da numaralar, numaraların karşısında da kodlar var.

yani 1006 02 gibi.

listede 15 adete kadar 1006 olsa bile yanında ki kodlar anlam yüklüyor.
anlam yükleyen kodlar maksiumum 15 adet olabilir.

1006 02
1006 03
1006 04

gibi.

örneğin. ben 1006 yı listele dediğimde,

sayfada ki tüm 1006 lar sıralansın ve karşısında ki kodla beraber kime ait olduğu gözüksün istiyorum.

örnek vermek gerekirse.

1006 yı listele dediğimde

2013 Yılı Sonuçları

1006 03 CSERIN
1006 04 BBALAN
1106 05 RFAHRI
1106 15 CSERIN


2012 Yılı Sonuçları

1006 03 RFAHRI
1006 04 BBALAN
1106 05 RFAHRI
1106 15 CSERIN

4 rakamlı kodlar
her yıl denk geliyor. kodları yıllar ayrıştıyor.

Birde bazı hücrelerde ş harfi var 4 rakamlı sutunlarda.
örneğin.

3003ş

Ben sorgulama yaparken, ş olmadan yapıyorum.
Yani 3003 ü listele dediğimde hücre de ş varsa

3003 03 RFAHRI

Onun iki rakamlı kodu kırmızı olabilir mi.

Çok meşakkatli durduğunun farkındayım.
Listeleme konusunda destek olabilirseniz, çok minnettar olucam.



Saygılarımla,

 

[acar6783]

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

http://www.excel.web.tr/f48/makro-ile-arama-yapmak-t105018.html

Sub listele1()
Application.ScreenUpdating = False

Set s1 = Sheets("ARAMA")

ARANAN = s1.Range("H6")
sayfa = Sheets.Count
For A = 1 To sayfa
AD = Sheets(A).Name

If AD <> "ARAMA" Then
Sheets(AD).Select
D = Cells(Rows.Count, 1).End(xlUp).Row
E = s1.Cells(Rows.Count, 1).End(xlUp).Row


For y = 1 To D

If ARANAN = Cells(y, 2) Then


c = c + 1
s1.Cells(E + c, 2) = Cells(y, 2)
s1.Rows(E + c).Interior.ColorIndex = renk

s1.Cells(E + c, 3) = Cells(y, 3)
s1.Cells(E + c, 4) = Cells(y, 4)
s1.Cells(E + c, 5) = AD

End If
Next
End If

Next



Sheets("ARAMA").Select
End Sub

Zafer bey kolay gelsin yukarıdaki likte bir dosya paylaşmışsınız teşekkürler.
Fakat arama yaptığımızda sanırım tüm sayfaların tüm hücrelerinde arama yapıyor. Uğraştım ama başaramadım tüm sayfaların sadece ilk sütununda arama yaptırıp karşılıklarını nasıl getirebiliriz

 

[zafer]

Merhaba

Aramayı 2. sütunda yapıyor
If ARANAN = Cells(y, 2) Then


If ARANAN = Cells(y, 1) Then
olarak değiştirin.

iyi çalışmalar

 

[acar6783]

Teşekkürler.
peki hocam;

D = Cells(Rows.Count, 1).End(xlUp).Row
E = s1.Cells(Rows.Count, 1).End(xlUp).Row

s1.Cells(E + c, 3) = Cells(y, 3)

Kodun bu satırlarında
ben ek yapıp

s1.Cells(E + c, 1) = Cells(y, 1)

eklediğimde ilk bulunan değer satırı kadar boş satıra ekleyip o şekilde devam ediyor.
misal aradığım değer sayfa1 de 5 satırda varsa o 5 satırı yazıyor altalta ve eğer sayfa 2 de de aynı değerden varsa o ilk bulunan 5 satırlık değerlerin altına 5 tane boş satır ekleyip ondan sonra sayfa 2dekideğerleri yazıyor..

 

[zafer]

Merhaba

Sorunuzu tam anlayamadım ?

Yazdığınız kodların açıklamalarınımı istiyorsunuz ?

 

[acar6783]

s1.Cells(E + c, 1) = Cells(y, 1)

Hocam şöyle deyim
ben bu satırı koda eklediğimde aradığım yani ARANAN = s1.Range("H6") değer misal sayfa 1de 5 satırda var bu satırları ARAMA sayfasına kopyalıyor ve eğer başka sayfada da varsa o sayfada bulduğu satırları da ilk bulduğu satırların altına 5 tane boş satır ekleyip o şekilde devam ediyor.

Bu boş satırı neden ekliyor?

 

[zafer]

Merhaba

Kırmızı renkli kodları kendi kodlarınıza ilave ediniz.

For A = 1 To sayfa
AD = Sheets(A).Name
[B][COLOR=red]c = 0
[/COLOR][/B]If AD <> "ARAMA" Then
Sheets(AD).Select
D = Cells(65536, 1).End(xlUp).Row + 1
E = [COLOR=red][B]s1.[/B][/COLOR]Cells(65536, 1).End(xlUp).Row + 1

 

[acar6783]

Teşekkürler Hocam ...

Bir sorum daha olsa kusura bakmayın..
Bu sıralamyı ben istediğim satırdan itibaren nasıl yaptırabilrim?
Misal "b11" den itibaren kopyalamaya başlasa?

 

[zafer]

Merhaba

Sub listele1()
Application.ScreenUpdating = False
Set s1 = Sheets("ARAMA")
s1.Range("A2:G65536").Clear
ARANAN = s1.Range("H6")
sayfa = Sheets.Count
For A = 1 To sayfa
AD = Sheets(A).Name
 
If AD <> "ARAMA" Then
Sheets(AD).Select
D = Cells(65536, 1).End(xlUp).Row + 1
For y = 2 To D
If ARANAN = Cells(y, 1) Then
C = C + 1
s1.Cells(C + 10, 2) = Cells(y, 2)
s1.Cells(C + 10, 3) = Cells(y, 3)
s1.Cells(C + 10, 4) = Cells(y, 4)
s1.Cells(C + 10, 5) = AD
End If
Next
End If
Next
 
Sheets("ARAMA").Select
End Sub

 

[acar6783]

Teşekkürler hocam
Çok oluyorum ama ; 1. sutuna ne yaparım ki sıra numarası verebilirim buluna değer kadar
1
2
3
4
5

 

[zafer]

Merhaba

Pazartesi veya akşam girebilirsem halletmeya çalışıyım


İyi akşamlar

 

[Emir Hüseyin Çoban]

. . .

Müsadenizle Zafer Bey.
Aşağıda belirttiğim satırı ilave ederek deneyiniz.

C = C + 1
[B][COLOR="Red"]s1.Cells(C + 10, 1) = C[/COLOR][/B]
s1.Cells(C + 10, 2) = Cells(y, 2)
s1.Cells(C + 10, 3) = Cells(y, 3)
s1.Cells(C + 10, 4) = Cells(y, 4)
s1.Cells(C + 10, 5) = AD

. . .

 

[zafer]

Merhaba

. . .

Müsadenizle Zafer Bey.
Aşağıda belirttiğim satırı ilave ederek deneyiniz.

C = C + 1
[B][COLOR=red]s1.Cells(C + 10, 1) = C[/COLOR][/B]
s1.Cells(C + 10, 2) = Cells(y, 2)
s1.Cells(C + 10, 3) = Cells(y, 3)
s1.Cells(C + 10, 4) = Cells(y, 4)
s1.Cells(C + 10, 5) = AD

. . .

Rica ederim. İyi çalışmalar

 

[acar6783]

İlginiz için teşekkürler .
Başka bir şekilde çözdüm B sütunundaki değere göre sıra numaraası veriyor...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B4:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
Target.Offset(0, -1).Value = Target.Row - 3
End Sub

 

[muteferrika1]

elinize sağlık