Excel交流网
  • 设为首页|收藏本站|手机版
  • Excel-教程-技巧-培训视频

  • 网站首页
  • Excel教程
  • 关于我们
  • 新闻动态
  • Excel资源
  • 招贤纳士

Excel教程

Excel操作
Excel函数
Excel图表
Excel VBA
Excel 行业应用

联系方式

Excel中国 联系方式
电  话:400-855-3990
邮  编:528400
Email:support@zstm.com
网  址:www.excel-cn.com

当前位置:网站首页 > Excel教程 > Excel VBA
Excel VBA

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

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

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

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


提取相同字符串.JPG


运行自定义函数:

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

'功能:    查找雷同

'函数名:  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



提取字符串.gif

点击次数:  更新时间:2017-02-25 16:29:08  【打印此页】  【关闭】
上一条:EXCEL VBA轻松处理超难排名问题  下一条:VBA常见的单元格数据格式设置
本站动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图|网站管理

中山市天鸣科技发展有限公司 版权所有 1999-2020 粤ICP备10043721号

广东省中山市西苑广场富贵阁 528400

QQ:4008553990 电话:0760-88315075

Excel交流网主要交流Excel教程、Excel技巧、Excel培训、Excel函数公式、Excel图表以及Excel VBA,为网友提供一个最全的Excel交流网站

Excel教程|Excel技巧|Excel培训|Excel函数公式|Excel图表|VBA

Powered by MetInfo 5.3.12 ©2008-2022  www.metinfo.cn