arama makrosu ama biraz farklı

[skipper2005]

arkadaşlar arama yaptım ama bulamadım.benim istediğim arama makrosu ama tek kelime yazıcam makro ile bütün satırlar taranacak ve o kelimenin içinde geçtiği tüm satırları rapor denen diğer sayfaya dökecek.forumda bir sürü arama makrosu var yalnız benim bulduklarım autofilter yapıyor.
biraz daha açıklamak gerekirse mesela "mavi" kelimesini yazıcam.
ama mavi bir satırda ürün adında geçerken diğerinde ürünün renk bölümünde geçebilir.hatta aynı satırda 2 defa da bulunabilir.içinde mavi geçen ne olursa olsun tüm satırlar ayrı bir rapor sayfasına yazdırılacak.

verildiyse özür dilerim herkesten.yeniyim acemiliğime verin.

 

[AS3434]

Sayın skipper2005

Dosyayı inceleyin.

 

[skipper2005]

arkadaşım kusura bakma heralde anlatamadım tam olarak derdimi.
esas ihtiyacım olan aşağıda resimlerdeki gibi olacak.yardımın için çok teşekkür ederim.

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.
Kodları kendinize göre uyarlayabilirsiniz.

Sub suz()
Dim sat As Long, i As Long, k As Byte, j As Byte
Sheets("Sayfa1").Select
Sheets("Sayfa2").Range("A2:D65536").ClearContents
If Range("F1").Value = "" Then Exit Sub
sat = 2
For i = 1 To Cells(65536, "A").End(xlUp).Row
    For k = 1 To 4
        If LCase(Replace(Replace(Cells(i, k).Value, "I", "ı"), "İ", "i")) Like _
        LCase(Replace(Replace(Sheets("sayfa1").Range("F1").Value, "I", "ı"), "İ", "i")) & "*" Then
            For j = 1 To 4
                Sheets("Sayfa2").Cells(sat, j).Value = Cells(i, j).Value
            Next j
        sat = sat + 1
        Exit For
        End If
    Next k
Next i
MsgBox "S A Y F A'2 Y E  A K T A R M A    Y A P I L D I ..!!"
End Sub

 

[skipper2005]

çok teşekkür ederim istediğim tam olarak buydu.
ne kadar işime yaradı bilemezsiniz.

 

[Orion1]

çok teşekkür ederim istediğim tam olarak buydu.
ne kadar işime yaradı bilemezsiniz.

Rica ederim.
İşinize yaradığına sevindim.
İyi çalışmalar.

 

[skipper2005]

bunu bi ileri kademeye taşımaya çalıştım ama ben beceremedim. malum tecrübesizlik. şimdi bu verdiğiniz makroda anahtar kelime eğer hücrede ilk kelimeyse buluyo. hücrede birden fazla kelime varsa mesela deniz mavisi dedi hücrede mavi yazdığım zaman aramaya deniz mavisini çıkarmıyor.bunu nası buldurabilirim.

şimdiden sonsuz teşekkür

 

[Orion1]

Merhaba .
Aşağıdaki şekilde denermisiniz.

Sub suz()
Dim sat As Long, i As Long, k As Byte, j As Byte
Sheets("Sayfa1").Select
Sheets("Sayfa2").Range("A2:D65536").ClearContents
If Range("F1").Value = "" Then Exit Sub
sat = 2
For i = 1 To Cells(65536, "A").End(xlUp).Row
    For k = 1 To 4
        If LCase(Replace(Replace(Cells(i, k).Value, "I", "ı"), "İ", "i")) Like _
        "*" & LCase(Replace(Replace(Sheets("sayfa1").Range("F1").Value, "I", "ı"), "İ", "i")) & "*" Then
            For j = 1 To 4
                Sheets("Sayfa2").Cells(sat, j).Value = Cells(i, j).Value
            Next j
        sat = sat + 1
        Exit For
        End If
    Next k
Next i
MsgBox "S A Y F A'2 Y E  A K T A R M A    Y A P I L D I ..!!"
End Sub

 

[skipper2005]

denedim olmuyo.ben mi sakarlık yapıyorum acaba bi yerde.

 

[skipper2005]

ya çok afedersiniz. benim hatam " işaretinin bi tanesi eksik kalmış. çalışıyor.
süpersiniz.
bence sizin nickiniz hızır olmalı. hızır gibi yetişiyosunuz.

 

[Orion1]

ya çok afedersiniz. benim hatam " işaretinin bi tanesi eksik kalmış. çalışıyor.
süpersiniz.
bence sizin nickiniz hızır olmalı. hızır gibi yetişiyosunuz.

Sizde süpersiniz.
İyi çalışmalar.

 

[backstreet]

arkadaşlar bende işim için kullandım bu yazdığınız makroyu. öncelikle onun için çok teşekkür ederim.
benim de bi ricam olacak.benim kullandığım excelde normal sayfamda yazıların üzerinde köprü var , bunlar word dosyası açıyor. birde bunlara ek olarak bazı satırlarımda açıklama lar var. bu köprüleri bozmadan ikinci sayfayada aktarabilirmiyiz?

 

[keltosh]

link mi ölü ben de mi sorun var? indiremiyorum