统计相同字符串的个数-提取相同字符串且统计最大相同数

1.字符转中包括大小写字母、逗号、句号、下划线和空格。匹配不区分大小写。

2.能实现字符串中提取“相同部分”。且相同字符串的字母个数大于3才提取出来，因为2个以下有重复，不好实现，提取出来也没有意义。

3.且能统计最大相同字符串的数目。

运行自定义函数：

'****************************************************************

'功能：    查找雷同

'函数名：  LeiTong

'参数1：   LT_text     基准文字

'参数2：   within_text 比对文字

'参数3：   n           n个字符连续相同则判断雷同,

'参数4：   mode        模式，可省略，默认为：1，

'                      为1时，返回雷同字符

'                      为2时，返回雷同字数

'                      为21时，返回雷同字数|雷同字位置，连续字数；

'                      为3时，返回雷同度 (基准第一参数)，字符型

'                      为30时，返回雷同度 (基准第一参数)，数字型

'                      为4时，返回雷同度 ，字符型

'                      为40时，返回雷同度 ，数字型

'                      为5时，返回雷同度 (基准第一二参数较长者)，字符型

'                      为50时，返回雷同度(基准第一二参数较长者) ，数字型

'                      为6时，返回雷同度 (基准第一二参数较短者)，字符型

'                      为60时，返回雷同度(基准第一二参数较短者) ，数字型

'                      为负数时，返回非雷同字符（对应）

'参数5：   Case_insensitive     为True时,忽略大小写。可省略，默认为：False

'参数6：   NoRepeat    为True时,无重复，within_text只匹配一次。可省略，默认为： True

'参数7：   homophone   为True时,同音字匹配。可省略，默认为： False

'返回值：  一个数字型或字符型

'使用方法：arr = LeiTong(A, B,4)

Public Function LeiTong(LT_text, within_text, Optional n = 3, Optional mode = 1, Optional Case_insensitive = False, Optional NoRepeat = True, Optional homophone = False)

'查找雷同

    Dim arr(), brr(1 To 3), crr(1 To 3), drr() As Boolean

    Dim LT_p As Boolean, LT_fl, LT_2

    If VarType(LT_text) <> vbString Or VarType(within_text) <> vbString Then

        LeiTong = CVErr(xlErrNA) '若LT_text、within_text非字符，则返回错误值

        Exit Function

    End If

    If Case_insensitive Then

        LT_text = UCase(LT_text)

        within_text = UCase(within_text)

    End If

    If NoRepeat >= 1 Then

        NoRepeat = True

    End If

    If homophone Then

'        LT_text = GetTY(LT_text)

'        within_text = GetTY(within_text)

    End If

        

    If n < 1 Then n = 1

    j = 0

    l0 = Len(LT_text)

    

    If l0 = 0 Then LeiTong = "基准字符为空": Exit Function

    If n > l0 Then n = l0

    ReDim arr(l0)

    brr(1) = ""

    brr(2) = 0

    brr(3) = 0

    crr(1) = ""

    crr(2) = 0

    crr(3) = 0

    For i = 1 To l0

        arr(i) = Mid(LT_text, i, 1)

    Next

        

    l1 = Len(within_text)

    ReDim drr(1 To l1)

    For i = 1 To l0

        i1 = 0

        LT_p = False

        LT_fl = LT_fl + 1

        

        Do While Not LT_p

        j = 1

        i2 = InStr(i1 + 1, within_text, arr(i))

        If i2 > 0 And i <= l0 Then

            Do While i2 + j <= l1

                If i + j > l0 Then Exit Do    'i = i + j - 1:

                If Mid(within_text, i2 + j, 1) = arr(i + j) And (Not NoRepeat Or Not drr(i2 + j)) Then

                    j = j + 1

                Else

                    Exit Do

                End If

            Loop

            

            If j >= n Then

                LT_p = True

                LT_fl = 0

                Exit Do

            End If

        Else

            Exit Do

        End If

        If i2 + j > l1 Then Exit Do

        i1 = i2

        Loop

        

        If LT_p Then

            brr(2) = brr(2) + j

            For di = i2 To i2 + j - 1

                drr(di) = True

            Next

            If brr(1) = "" Then

                brr(1) = Mid(LT_text, i, j)

                brr1s = i & "，" & j

            Else

                brr(1) = brr(1) & Chr(10) & Mid(LT_text, i, j)

                brr1s = brr1s & "；" & i & "，" & j

            End If

        Else

            If l0 - i - j + 1 < n Then

                j = l0 - i + 1

            End If

            crr(2) = crr(2) + j

            If crr(1) = "" Then

                crr(1) = Mid(LT_text, i, j)

                crr1s = i & "，" & j

            ElseIf LT_fl > 1 Then

                crr(1) = crr(1) & Mid(LT_text, i, j)

                crr1s = crr1s & "；" & i & "，" & j

            Else

                crr(1) = crr(1) & Chr(10) & Mid(LT_text, i, j)

                crr1s = crr1s & "；" & i & "，" & j

            End If

           

        End If

        i = i + j - 1

    Next

    

    

    mode = Int(mode)

    If mode = 0 Then mode = 1

    If Abs(mode) > 2 Then

        If Abs(mode) = 4 Or Abs(mode) = 40 Then

            LT_2 = LeiTong(within_text, LT_text, n, 30, Case_insensitive)

        Else

            LT_2 = 1

        End If

        Select Case mode

            Case 21

                brr(2) = brr(2) & "|" & brr1s

                mode = 2

            Case -21

                crr(2) = crr(2) & "|" & crr1s

                mode = -2

            Case 3

                brr(3) = Format(brr(2) / l0, "0.00%")

            Case 30

                brr(3) = brr(2) / l0

                mode = 3

            Case -3

                crr(3) = Format(crr(2) / l0, "0.00%")

            Case -30

                crr(3) = crr(2) / l0

                mode = -3

            Case 4

                brr(3) = Format((brr(2) * LT_2 / l0) ^ 0.5, "0.00%")

                mode = 3

            Case 40

                brr(3) = (brr(2) * LT_2 / l0) ^ 0.5

                mode = 3

            Case -4

                crr(3) = Format(1 - (brr(2) * LT_2 / l0) ^ 0.5, "0.00%")

                mode = -3

            Case -40

                crr(3) = 1 - (brr(2) * LT_2 / l0) ^ 0.5

                mode = -3

            Case 5

                brr(3) = Format(crr(2) / IIf(l0 > l1, l0, l1), "0.00%")

                mode = 3

            Case 50

                brr(3) = brr(2) / IIf(l0 > l1, l0, l1)

                mode = 3

            Case -5

                crr(3) = Format(crr(2) / IIf(l0 > l1, l0, l1), "0.00%")

                mode = -3

            Case -50

                crr(3) = crr(2) / IIf(l0 > l1, l0, l1)

                mode = -3

            Case 6

                brr(3) = Format(crr(2) / IIf(l0 < l1, l0, l1), "0.00%")

                mode = 3

            Case 60

                brr(3) = brr(2) / IIf(l0 < l1, l0, l1)

                mode = 3

            Case -6

                crr(3) = Format(crr(2) / IIf(l0 < l1, l0, l1), "0.00%")

                mode = -3

            Case -60

                crr(3) = crr(2) / IIf(l0 < l1, l0, l1)

                mode = -3

            Case Else

                mode = 1

        End Select

        

    End If

    If mode > 0 Then

        LeiTong = brr(mode)

    Else

        LeiTong = crr(-mode)

    End If

End Function