Uygun CÜmleyİ Bulma

[karakayalı]

A sutunuda belirlediğim kelimeler var. B1 sutununa da bulunmasını istediğim harf sayısını yazdım...bulunmasını istediğim kelimenin bazı harfleri belli olabilir...buna göre uygun cümleyi bulmak istiyorum...dosya ektedir...kolay gelsin

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.
Not:Bu sayfayı yalnızca Bu işlem için kullanınız.Zira
aşağıdaki kod ile hemen hemen sayfanın tamamı siliniyor.

Range("B3:IV65536").Clear

Sub bul()
Dim sat, k As Long, i, j As Integer, sayac As Byte
Sheets("Sayfa1").Select
Range("B3:IV65536").Clear
sat = 3
For k = 1 To [A65536].End(3).Row
    If Len(Cells(k, "A").Value) > Range("B1").Value Then GoTo atla
    If Cells(k, "A").Value <> "" Then
        harf_uzunluk = Range("B1").Value
        If Len(Cells(k, "A").Value) < harf_uzunluk Then
            harf_uzunluk = Len(Cells(k, "A").Value)
            Else
            harf_uzunluk = Range("B1").Value
        End If
        For i = 1 To harf_uzunluk
            If Cells(2, i + 1).Value <> "" Then
                If Mid(Cells(k, "A").Value, i, 1) = Cells(2, i + 1).Value Then
                sayac = 1
                End If
            End If
        Next i
        If sayac = 1 Then
            For j = 1 To Len(Cells(k, "A").Value)
                Cells(sat, j + 1).Value = Mid(Cells(k, "A").Value, j, 1)
            Next j
            sat = sat + 1
            sayac = 0
        End If
    End If
atla:
Next k
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[karakayalı]

çok teşekkür ederim...yalnız bu B1 hücresine girdiğim rakamla sınırlı kalabilir mi... örneğin 5 harfli girmişsem sadece bana 5 harften oluşan cümleleri getirsin...kolay gelsin...

 

[Ferhat Pazarçevirdi]

Merhabalar,

Ekteki örneği inceleyiniz.

Sub KelimeBul()
Dim i%, j%, y%, satir%, bulunan%
Dim harf As String
Range("B4:P10000").ClearContents
Cells(3, 2) = "Bulunanlar ..."
For i = 1 To Cells(65536, 1).End(xlUp).Row
    If Len(Cells(i, 1)) = Cells(1, 2) Then
       For j = 1 To Cells(1, 2)
          harf = Mid(Cells(i, 1), j, 1)
          If harf = Cells(2, j + 1) Or harf = UCase(Cells(2, j + 1)) Or harf = LCase(Cells(2, j + 1)) Or Cells(2, j + 1) = Empty Then: y = y + 1
       Next j
       If y = Cells(1, 2) Then
          satir = Cells(65536, 2).End(xlUp).Row + 1
          For j = 1 To Cells(1, 2)
              Cells(satir, j + 1) = Mid(Cells(i, 1), j, 1)
          Next j
          bulunan = bulunan + 1
       End If
       y = 0
    End If
Next i
If bulunan <> 0 Then: Cells(3, 2) = "Bulunanlar ... " & "Toplam : " & bulunan & " adet"
End Sub

 

[Orion1]

çok teşekkür ederim...yalnız bu B1 hücresine girdiğim rakamla sınırlı kalabilir mi... örneğin 5 harfli girmişsem sadece bana 5 harften oluşan cümleleri getirsin...kolay gelsin...

Dosyayı güncelledim.
2 numaralı mesajdan indirebilirsiniz.

 

[karakayalı]

Ellerİnİze SaĞlik...tŞk.