karakterler arasındaki uzaklığı hesaplama

Mehmet Şahin

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
Ş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.
 
Katılım
7 Haziran 2011
Mesajlar
12
Excel Vers. ve Dili
2007
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

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
Tamam, şimdi anlaşıldı. Kodlar güncelleniyor...
 

Mehmet Şahin

Destek Ekibi
Destek Ekibi
Katılım
13 Ekim 2005
Mesajlar
1,406
Excel Vers. ve Dili
Excel 2010 - 2013 Türkçe - İngilizce
Merhaba,
aşağıdaki kodu dener misiniz?
İyi günler.

Kod:
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
 
Son düzenleme:
Katılım
7 Haziran 2011
Mesajlar
12
Excel Vers. ve Dili
2007
Teşekkürler..deneyeceğim hemen..
 
Üst