karakterler arasındaki uzaklığı hesaplama

[Mehmet Şahin]

Şimdi "hsjdaadjaaakaa.." ya da "hsjdaaaadjaaakaa.." gibi benzer durumlarda nasıl davranmalı kod, bilgimiz yok.

Sayın atubaa,
Geç yanıt için özür.
Alıntıda belirtmiş olduğumuz durumda nasıl bir sonuç vermeli, bunu belirtirseniz kodu oluşturabilirim.

 

[atubaa]

hsjdaadjaaakaa.." bunun için 1.66 sonucunu çıkartması lazım.hsjdaaaadjaaakaa için ise (0+3+2+2+1)/5 yani 1.6

İlgilendiğiniz için tekrar teşekkürler..

 

[Mehmet Şahin]

Tamam, şimdi anlaşıldı. Kodlar güncelleniyor...

 

[Mehmet Şahin]

Merhaba,
aşağıdaki kodu dener misiniz?
İyi günler.

Sub bul()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sayfa1")
sn = sh.[a65536].End(3).Row
Dim i, x, q, s As Long
Application.ScreenUpdating = False
sh.Range("c2:c" & sn).ClearContents
For Z = 2 To sn
        a = Cells(Z, "a") 'aranacak tümce
        x = Cells(Z, "b") 'aranan
        If a = "" Then Exit For
        s = 0 'kaç kez var
        q = 0 'toplam değer
        If InStr(1, a, x, 3) = 0 Then GoTo 10
        bas = InStr(1, a, x, 3)
        If InStr(1, Mid(a, bas + 1, Len(a) - bas), x, 3) < 1 Then GoTo 10 'sadece bir kez varsa çık
        For i = 1 To Len(a)
         If Len(Mid(a, i + Len(x), Len(a))) = Len(x) Then GoTo son
          If InStr(1, Mid(a, i, Len(a)), x, 3) = 1 Then  'ilk sıradaysa
            If InStr(1, Mid(a, i + Len(x), Len(a)), x, 3) = 1 Then 'sonraki bulunan ilk sırada ise
            Else
              w = InStr(1, Mid(a, i + Len(x), Len(a)), x, 3) - 1
              q = q + w
            End If
         s = s + 1
         End If
             If InStr(1, Right(a, Len(a) - i), x, 3) < 1 Then Exit For
        Next i
son:
        If q = 0 Then GoTo 10
        sh.Cells(Z, "c") = q / s
        sh.Cells(Z, "d") = q
        sh.Cells(Z, "e") = s
10:
Next Z
Application.ScreenUpdating = True
Set sh = Nothing
End Sub

 

[atubaa]

Teşekkürler..deneyeceğim hemen..