Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
784to788
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
784to788
784to788
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
Anzeige
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
Anzeige
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
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige