[已解决]去数字不彻底

张雄友

hwc2ycy 发表于 2013-7-16 18:03
当然用数组的方式快啦。
你可以改下。

版主，我只会调用自定义函数，还不会数组。

hwc2ycy

张雄友 发表于 2013-7-16 18:05
版主，我只会调用自定义函数，还不会数组。

有事出去了，回来再说。

张雄友

hwc2ycy 发表于 2013-7-16 18:37
有事出去了，回来再说。

经测试，代码只对单列，或者双列有效，对三列以上无效的。

Sub 去数字()
    Dim arr
    Dim i As Long
    Dim n As Long
    arr = Selection
    Selection.NumberFormatLocal = "@"
    n = UBound(arr)
    For i = 1 To n
        arr(i, 1) = rp(arr(i, 1))
    Next
    Selection = arr
End Sub
Function rp(rg) As String
    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.regExp")
    rp = rg
    With objRegExp
        .Global = True
         .Pattern = "(\d+?)(\.\d+)?"
            If .test(rg) Then
                rp = .Replace(rg, "")
            End If
    End With
    Set objRegExp = Nothing
End Function

hwc2ycy

你这里考虑不周全，当你选择的是一个单元格或多个区域时，就不一样了

张雄友

hwc2ycy 发表于 2013-7-16 21:50
你这里考虑不周全，当你选择的是一个单元格或多个区域时，就不一样了

具体怎么修改？版主明示！

hwc2ycy

1. Sub 去数字()
   
2.     Dim arr
   
3.     Dim i As Long
   
4.     Dim j As Long
   
5.     Dim rg As Range
   
6.    
   
7.     If Not TypeName(Selection) = "Range" Then
   
8.         Exit Sub
   
9.     End If
   
10.    
    
11.     Application.ScreenUpdating = False
    
12.    
    
13.     Selection.NumberFormatLocal = "@"
    
14.    
    
15.     For Each rg In Selection.Areas
    
16.         If rg.Count = 1 Then
    
17.             rg.Value = rp(rg.Value)
    
18.         Else
    
19.             arr = rg.Value
    
20.             For i = LBound(arr) To UBound(arr)
    
21.                 For j = LBound(arr, 2) To UBound(arr, 2)
    
22.                     arr(i, j) = rp(arr(i, j))
    
23.                 Next
    
24.             Next
    
25.             rg.Value = arr
    
26.         End If
    
27.     Next
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "替换完成"
    
30. End Sub
    
31. Function rp(rg) As String
    
32.     Dim objRegExp As Object
    
33.     Set objRegExp = CreateObject("VBScript.regExp")
    
34.     rp = rg
    
35.     With objRegExp
    
36.         .Global = True
    
37.         .Pattern = "(\d+?)(\.\d+)?"
    
38.         If .test(rg) Then
    
39.             rp = .Replace(rg, "")
    
40.         End If
    
41.     End With
    
42.     Set objRegExp = Nothing
    
43. End Function
    

复制代码

hwc2ycy

If Not TypeName(Selection) = "Range" Then
这句可以改成
If  TypeName(Selection) <> "Range" Then