0

我正在编写一个 VBA 脚本,该脚本将处理大量电子邮件地址并标记那些被怀疑是错误的地址。

我想通过添加一个函数来改进例程,该函数可以发现常见域名(如 gmail、hotmail、msn、skynet 等)中的拼写错误。我将在数组中列出这些常见显示名称。

string 函数将查看输入的字符串是否看起来相似但与数组中的元素不同,如果是,则返回 true 作为布尔值。

想法是发现错误的条目,例如:homtail、mns、slynet、hotmal、yahooo 等。

不是在寻找脚本本身,而是在寻找如何解决这个问题的灵感......

4

2 回答 2

2

你需要一个模糊的comarison - 这里有代码可以比较两个字符串,并根据它们的接近程度给你一个从0到1的分数。由您决定它们与自动替换的接近程度。

示例结果:

服务器文本模糊分数
-------- -------- -----------
hotmail hotmale 0.7619048
hotmail 热 0.4285714
hotmail notmail 0.8571429
hotmail NotEvenClose 0.1944444
热信 热信 1
hotmail 黄色 0.0952381
hotmail homtail 0.7142857

源代码已在 GNU Lesser GPL 下发布


在链接腐烂的情况下,这里是代码:

Public Function Fuzzy(ByVal s1 As String, ByVal s2 As String) As Single
Dim i As Integer, j As Integer, k As Integer, d1 As Integer, d2 As Integer, p As Integer
Dim c As String, a1 As String, a2 As String, f As Single, o As Single, w As Single
'
' ******* INPUT STRINGS CLEANSING *******
'
s1 = UCase(s1)        'input strings are converted to uppercase
d1 = Len(s1)
j = 1
For i = 1 To d1
    c = Mid(s1, i, 1)
    Select Case c
        Case "0" To "9", "A" To "Z"        'filter the allowable characters
            a1 = a1 & c        'a1 is what remains from s1 after filtering
            j = j + 1
    End Select
Next
If j = 1 Then Exit Function        'if s1 is empty after filtering
d1 = j - 1
s2 = UCase(s2)
d2 = Len(s2)
j = 1
For i = 1 To d2
    c = Mid(s2, i, 1)
    Select Case c
        Case "0" To "9", "A" To "Z"
            a2 = a2 & c
            j = j + 1
    End Select
Next
If j = 1 Then Exit Function
d2 = j - 1
k = d1
If d2 < d1 Then        'to prevent doubling the code below s1 must be made the shortest string,
    'so we swap the variables
    k = d2
    d2 = d1
    d1 = k
    s1 = a2
    s2 = a1
    a1 = s1
    a2 = s2
Else
    s1 = a1
    s2 = a2
End If
If k = 1 Then        'degenerate case, where the shortest string is just one character
    If InStr(1, s2, s1, vbBinaryCompare) > 0 Then
        Fuzzy = 1 / d2
    Else
        Fuzzy = 0
    End If
Else        '******* MAIN LOGIC HERE *******
    i = 1
    f = 0
    o = 0
    Do        'count the identical characters in s1 and s2 ("frequency analysis")
        p = InStr(1, s2, Mid(s1, i, 1), vbBinaryCompare)
        'search the character at position i from s1 in s2
        If p > 0 Then        'found a matching character, at position p in s2
            f = f + 1        'increment the frequency counter
            s2 = Left(s2, p - 1) & "~" & Mid(s2, p + 1)
            'replace the found character with one outside the allowable list
            '(I used tilde here), to prevent re-finding
            Do        'check the order of characters
                If i >= k Then Exit Do        'no more characters to search
                If Mid(s2, p + 1, 1) = Mid(s1, i + 1, 1) Then
                    'test if the next character is the same in the two strings
                    f = f + 1        'increment the frequency counter
                    o = o + 1        'increment the order counter
                    i = i + 1
                    p = p + 1
                Else
                    Exit Do
                End If
            Loop
        End If
        If i >= k Then Exit Do
        i = i + 1
    Loop
    If o > 0 Then o = o + 1        'if we got at least one match, adjust the order counter
    'because two characters are required to define "order"
finish:
    w = 2        'Weight of characters order match against characters frequency match;
    'feel free to experiment, to get best matching results with your data.
    'If only frequency is important, you can get rid of the second Do...Loop
    'to significantly accelerate the code.
    'By altering a bit the code above and the equation below you may get rid
    'of the frequency parameter, since the order counter increments only for
    'identical characters which are in the same order.
    'However, I usually keep both parameters, since they offer maximum flexibility
    'with a variety of data, and both should be maintained for this project
    Fuzzy = (w * o + f) / (w + 1) / d2
End If
End Function
于 2013-08-21T15:21:52.523 回答
1

您想要做的是称为汉明码(或汉明距离) - 试试这个

于 2013-08-21T15:05:27.043 回答