Levenshtein

Forumthread: Levenshtein

Levenshtein

28.07.2006 22:42:13

{Boris}

Hi Leute,
gibt es eigentlich in VBA eine UDF für den Levenshtein-Algorithmus?
Nach dem Motto:


Function Levenshtein(Suchbegriff As String, Vergleichsbegriff As String) As Integer
End Function

Darum geht´s: http://www.levenshtein.de/
Grüße Boris

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Levenshtein

28.07.2006 23:05:23

Josef
Da hab ich ja was zum Probieren...

28.07.2006 23:24:44

{Boris}
noch'n Tipp

29.07.2006 09:33:24

Rolf
AW: Da hab ich ja was zum Probieren...

29.07.2006 10:15:45

Uwe
Ich hab´s einfach nicht gesehen...

29.07.2006 13:51:24

{Boris}

AW: Levenshtein

28.07.2006 23:05:23

Josef

Servus Boris,
hab hier http://www.google.com/url?sa=D&q=http://groups.google.com/groups%3Fselm%3DeRlSt2HKBHA.1592%2540tkmsftngp04
das gefunden.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Function mp(s1 As String, s2 As String) As Double
Dim t As String
Dim i As Long, n As Long

'ensure s1 is shorter string - remove if undesired
If Len(s1) > Len(s2) Then
  t = s1
  s1 = s2
  s2 = t
End If

n = Len(s1)
i = 1
t = s1

'eliminate chars from s1 that aren't in s2
Do While i <= n
  If InStr(s2, Mid(t, i, 1)) > 0 Then
    i = i + 1
  Else
    t = Left(t, i - 1) & Mid(t, i + 1)
    n = n - 1
  End If
Loop

mp = mpr(t, s2) / CDbl(Len(s1))
End Function

'call this only from mp() and recursively to give the
'number of chars in s1 matching chars in order in s2
'
Private Function mpr(ByVal s1 As String, s2 As String) As Long
Dim i As Long, n1 As Long, p As Long, q As Long, m As Long

n1 = Len(s1)
q = 1

'find each char from s1 in substrings of s2 to
'the right of the previously matched char in s2
For i = 1 To n1
  p = InStr(q, s2, Mid(s1, i, 1))
  If p > 0 Then q = p + 1 Else Exit For
Next i

If i > n1 Then
  'if the For-loop above completed, i = n1 + 1 AND all
  'chars in s1 were found in s2 in order, so all done
  mpr = n1
Else
  'no joy, time for recursion with substrings of s1
  For i = 1 To n1
    m = mpr(Left(s1, i - 1) & Mid(s1, i + 1), s2)
    If m > mpr Then mpr = m 'store longest match found
    If mpr = n1 - 1 Then Exit For 'if longest substring matches, all done
  Next i
End If
End Function

Interessant vieleicht auch dieser
http://www.google.com/url?sa=D&q=http://groups.google.com/groups%3Fhl%3Dfr%26lr%3D%26ie%3DUTF-8%26oe%3DUTF-8%26c2coff%3D1%26selm%3De5VSnQmYDHA.1940%2540TK2MSFTNGP10.phx.gbl
und dieser hier
http://www.google.com/url?sa=D&q=http://groups.google.com/groups%3Fq%3Dg:thl2429514060d%26dq%3D%26hl%3Dfr%26lr%3D%26ie%3DUTF-8%26oe%3DUTF-8%26c2coff%3D1%26selm%3DeQ4MqolJDHA.2244%2540TK2MSFTNGP10.phx.gbl

Gruß Sepp

Da hab ich ja was zum Probieren...

28.07.2006 23:24:44

{Boris}

Hi Sepp,
besten Dank! Bin selbst wirklich zu blöd zum Googeln (hab´s nicht gefunden) ;-)
Grüße Boris

noch'n Tipp

29.07.2006 09:33:24

Rolf

Hi Boris,
hier noch ein Tipp aus einem benachbarten Forum
http://www.online-excel.de/fom/fo_read.php?f=1&bzh=12179&h=12173#a123x
hG
Rolf

AW: Da hab ich ja was zum Probieren...

29.07.2006 10:15:45

Uwe

Hallo, Boris,
besten Dank für Deine Frage, die zeigt, dass man auch durch die Antworten zulernen kann, die andere stellen.
In Deinem Hinweis-Link, dass in das Thema Levenshtein-Algorithmus einführt, gibt auf der Linkseite auch den Veweise auf
Umfassende Information, inkl. Sample-Code für Java, C++ und Visual Basic.
Hattest Du diesen Ansatz bereits probiert und als nicht ausreichend befunden?
Gruß,
Uwe

Ich hab´s einfach nicht gesehen...

29.07.2006 13:51:24

{Boris}

Hi Uwe,
bis zum VB-Teil hab ich einfach nicht gescrollt ;-))
My fault!
Grüße Boris

Beliebteste Forumthreads (12 Monate)

Forumthread: Levenshtein

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread