作者：绿色风
分类：
时间：2022-08-17
浏览：115
楼主
BIN_YANG168 |
Q：怎样用自定义函提取两个单元格中的重复内容，如：我是中国人
我爱中国 变为：中国
A：按Alt+F11，插入→模块→在VBE窗口中输入以下代码：
- Function LCS(ByVal A As String, ByVal B As String) As String
- If Len(A) * Len(B) = 0 Then LCS = "": Exit Function
- Dim la As Integer, lb As Integer, achar() As String, bchar() As String, c() As Integer, i As Integer, j As Integer, max As Integer
- la = Len(A)
- lb = Len(B)
- ReDim achar(la - 1)
- ReDim bchar(lb - 1)
- ReDim c(la - 1)
- For i = 1 To la
- achar(i - 1) = Mid(A, i, 1)
- Next
- For i = 1 To lb
- bchar(i - 1) = Mid(B, i, 1)
- Next
- max = 0
- For i = 0 To lb - 1
- For j = la - 1 To 0 Step -1
- If bchar(i) = achar(j) Then
- If i * j = 0 Then
- c(j) = 1
- Else
- c(j) = c(j - 1) + 1
- End If
- Else
- c(j) = 0
- End If
- If c(j) > max Then max = c(j): LCS = Mid(A, j + 2 - max, max)
- Next
- Next
- If max = 0 Then LCS = ""
- End Function
- Function LC(A As String, B As String)
- Dim i%: Dim ii%
- For i = 1 To Len(A)
- For ii = i To Len(A)
- If B Like "*" & Mid(A, i, ii - i + 1) & "*" Then
- If ii - i + 1 > Len(LC) Then
- LC = Mid(A, i, ii - i + 1)
- End If
- Else
- Exit For
- End If
- Next ii
- Next i
- End Function
然后在A1,B1单元格输入需要的文本，在其他单元格输入=LCS(A1,B1)或=LC(A1,B1)即可。
 提取两个单元格重复内容的自定义函数.rar
|
2楼
omnw |
代码很长的一个函数噢，学习了！ |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一