arama ve bulma makrosu (küçük bir yardım lazım)

[jack_extreme]

merhaba yardımlarınız için öncelikle çok teşekkürler küçük bir yardıma ihtiyacım var bununla ilgili bir deneme yaptım ama olmadı
sayfa 4 den almış olduğu kelimeleri sayfa 5 te arasın bulabilirse sayfa 6 ya yazsın istiyorum bir kod yazdım ama çalıştıramadım konuyla ilgili yardımcı olabilirseniz çok sevinirim

Sub TEST()
Dim FindWord As String, Found As Range
    FindWord = Sheets("Sayfa4").Range("A:B:C:D:E:F")
    Set Found = Sheets("Sayfa5").Cells.Find(What:=FindWord, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlPart, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlNext, _
                                            MatchCase:=False)
                                        
    If Not Found Is Nothing Then
        Found.Select
        Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.copy
    Sheets("Sayfa6").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Else
        MsgBox "BUGÜN ÖDEME YOK :("
    End If

End Sub

 

[Asri]

Öncelikle sorunuzda bazı konuların açıklık kazanması gerekiyor.

* her bir satırdaki tüm kelimeler sayfa5 de bulunmalı mı?
* Her bir satırdaki tüm kelimelerden herhangi bir sayfa5 de bulunması yeterli mi?
* Sayfa5 de kelime bulunduğunda bu kelime sayfa5 de var mı denecek?
* Aranan bu kelime sayfa5 de bu cümlenin içinde bulundumu denecek.
* Aranan aynı satırdaki bir den fazla kelime sayfa5 de birden fazla satırda bulunduğunda ne yapılacak?
* Aranan aynı satırdaki bir den fazla kelime sayfa5 de tek cumle içinde birden fazla kelime bulunur ise ne yapılacak?

Bu gibi durumlar için açıklama yapabilirseniz daa doğru ve hızlı sonuç alırsınız.

 

[jack_extreme]

Öncelikle sorunuzda bazı konuların açıklık kazanması gerekiyor.

* her bir satırdaki tüm kelimeler sayfa5 de bulunmalı mı?
herhangi biri bulunsa yeterli olacaktır

* Her bir satırdaki tüm kelimelerden herhangi bir sayfa5 de bulunması yeterli mi?
herhangi biri bulunsa yeterli olacaktır

* Sayfa5 de kelime bulunduğunda bu kelime sayfa5 de var mı denecek?
sayfa 6 koplayasa daha iyi olur

* Aranan bu kelime sayfa5 de bu cümlenin içinde bulundumu denecek.
sayfa 6 koplayasa daha iyi olur

* Aranan aynı satırdaki bir den fazla kelime sayfa5 de birden fazla satırda bulunduğunda ne yapılacak?
birden fazla kelimeyi kopyalayabilir çok sorun değil ben tek tek kontrol edebilirim benim amacım sadece uzun listeyi kısaltmak

* Aranan aynı satırdaki bir den fazla kelime sayfa5 de tek cumle içinde birden fazla kelime bulunur ise ne yapılacak?

Bu gibi durumlar için açıklama yapabilirseniz daa doğru ve hızlı sonuç alırsınız.

* her bir satırdaki tüm kelimeler sayfa5 de bulunmalı mı?
* Her bir satırdaki tüm kelimelerden herhangi bir sayfa5 de bulunması yeterli mi?
* Sayfa5 de kelime bulunduğunda bu kelime sayfa5 de var mı denecek?
* Aranan bu kelime sayfa5 de bu cümlenin içinde bulundumu denecek.
* Aranan aynı satırdaki bir den fazla kelime sayfa5 de birden fazla satırda bulunduğunda ne yapılacak?
* Aranan aynı satırdaki bir den fazla kelime sayfa5 de tek cumle içinde birden fazla kelime bulunur ise ne yapılacak?

 

[Asri]

Sonuc sayfasında cumle ve yanında ilk bulunan kelime olacaktır.
İçinde kelime bulunmayan cumleler sonuc sayfasına getirilmez.

Dim kelimeliste(1000000) As String
Dim Cumleliste(1000000, 2) As String
Dim cumlesayisi, kelimesayisi As Long

Sub menu()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
    Call sifirla
    Call kelime_yukle
    Call cumle_yukle
    Call buluver
    
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

Sub sifirla()
  Cells.Clear
  
  For i = 1 To 1000000
    kelimeliste(i) = ""
    Cumleliste(i, 1) = ""
    Cumleliste(i, 2) = ""
  Next i
  
End Sub

Sub buluver()
  say = 0
  For i = 1 To kelimesayisi
    kelime = kelimeliste(i)
    For j = 1 To cumlesayisi
      If Cumleliste(j, 2) = "" Then
         cumle = Cumleliste(j, 1)
         If InStr(cumle, kelime) > 0 Then
            Cumleliste(j, 2) = kelime
            Exit For
         End If
       End If
     Next j
   Next i
   
   Sheets("Sonuc").Select
   say = 0
   For i = 1 To cumlesayisi
     If Cumleliste(i, 2) <> "" Then
        say = say + 1
        Cells(say, "A").Value = Cumleliste(i, 1)
        Cells(say, "B").Value = Cumleliste(i, 2)
     End If
   Next i
   
End Sub

Sub cumle_yukle()
   Sheets("Veri").Select
   say = 0
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   For i = 1 To sonsatir
       cumle = Cells(i, "A").Value
       If cumle <> "" Then
          say = say + 1
          Cumleliste(say, 1) = cumle
       End If
   Next i
   cumlesayisi = say
End Sub

Sub kelime_yukle()
   Sheets("Kelimeler").Select
   sonsutun = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
   say = 0
   For j = 1 To sonsutun
     sonsatir = Cells(Rows.Count, j).End(3).Row
     For i = 1 To sonsatir
       kelime = Cells(i, j).Value
       If kelime <> "" Then
          say = say + 1
          kelimeliste(say) = kelime
       End If
     Next i
   Next j
   kelimesayisi = say
End Sub

 

[jack_extreme]

hocam çok teşekkürler eline sağlık istediğim gibi olmuş süpersin..