[已解决]用VBA去掉单元格内重复文本

fengdavid

如何通过VBA代码去掉单元格内重复文本呢，见附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-4-3 07:43

改进下，增加对str1的判断

1. Function 去重复数字(str1 As String, Optional delimiter As String = "-") As String
   
2.    
   
3.     If Len(str1) = 0 Then Exit Function
   
4.    
   
5.     If Not str1 Like "*" & delimiter & "*" Then
   
6.         Exit Function
   
7.     End If
   
8. 
   
9.     Dim arr
   
10.     arr = Split(str1, delimiter)
    
11.     Dim i As Integer
    
12. 
    
13.     For i = UBound(arr) To LBound(arr) Step -1
    
14.         If InStr(delimiter & 去重复数字, delimiter & arr(i) & delimiter) = 0 Then
    
15.             去重复数字 = arr(i) & delimiter & 去重复数字
    
16.         End If
    
17.     Next
    
18.    
    
19.     If Len(去重复数字) > 1 Then
    
20.        去重复数字 = (Left(去重复数字, Len(去重复数字) - 1))
    
21.     End If
    
22.    
    
23. End Function

复制代码

跳转到最佳答案楼层

hwc2ycy

A1的3也重复了，怎么还保留在？

hwc2ycy

1. Function 去重复数字(str1 As String, Optional delimiter As String = "-") As String
   
2.     If Not str1 Like "*" & delimiter & "*" Then
   
3.         Exit Function
   
4.     End If
   
5.     Dim arr
   
6.     arr = Split(str1, delimiter)
   
7.     Dim i As Integer
   
8. 
   
9.     For i = UBound(arr) To LBound(arr) Step -1
   
10.         If InStr(delimiter & 去重复数字, delimiter & arr(i) & delimiter) = 0 Then
    
11.             去重复数字 = arr(i) & delimiter & 去重复数字
    
12.         End If
    
13.     Next
    
14.    
    
15.     If Len(去重复数字) > 1 Then
    
16.        去重复数字 = (Left(去重复数字, Len(去重复数字) - 1))
    
17.     End If
    
18. End Function

复制代码

hwc2ycy

改进下，增加对str1的判断

1. Function 去重复数字(str1 As String, Optional delimiter As String = "-") As String
   
2.    
   
3.     If Len(str1) = 0 Then Exit Function
   
4.    
   
5.     If Not str1 Like "*" & delimiter & "*" Then
   
6.         Exit Function
   
7.     End If
   
8. 
   
9.     Dim arr
   
10.     arr = Split(str1, delimiter)
    
11.     Dim i As Integer
    
12. 
    
13.     For i = UBound(arr) To LBound(arr) Step -1
    
14.         If InStr(delimiter & 去重复数字, delimiter & arr(i) & delimiter) = 0 Then
    
15.             去重复数字 = arr(i) & delimiter & 去重复数字
    
16.         End If
    
17.     Next
    
18.    
    
19.     If Len(去重复数字) > 1 Then
    
20.        去重复数字 = (Left(去重复数字, Len(去重复数字) - 1))
    
21.     End If
    
22.    
    
23. End Function

复制代码

liuguansky

1. Function XX(R As Range, Optional K$ = "-") As String
   
2.     If IsMissing(K) Then K = "-"
   
3.     With CreateObject("vbscript.regexp")
   
4.         .Global = True: .Pattern = "(" & K & "\d+)(?=.+?\1)"
   
5.         If .test(K & R.Value) Then
   
6.             XX = Mid(.Replace(K & R.Value, ""), 2)
   
7.         End If
   
8.     End With
   
9.     Application.Volatile
   
10. End Function

复制代码

fengdavid

liuguansky 发表于 2013-4-3 09:11

这个代码有个缺陷，就是前两个数字重复时，结果返回为空