VBA操作VBA——提取数字

会使用Excel的人都知道数字和文本是应该分开列来存储的，可是总是会碰上一些人仅仅是把Excel当作制作表格的一个简单工具，至于使用函数进行数据处理是根本不会的！

甚至有些人根本就不需要运算，直接拿Word来制作表格的，仅仅是为了排版好看而已。

碰上这种情况，对于要使用Excel进行数据处理的人来说，真是比较痛苦的。把数字和文本写到一个单元格里的个人工作上还是比较常见的，所以把数字分离出来就需要经常来做了。

对于会使用VBA的人来说，一个一个的手动去复制肯定是受不了的，那么来看看使用VBA如何快速处理这种情况：

首先在customUI.xml的menu id="rbmenuNumber"中增加代码：

代码语言：javascript复制

        <button id="rbbtnGetNum" label="提取数字" onAction="rbbtnGetNum"/>

回调函数：

代码语言：javascript复制

Sub rbbtnGetNum(control As IRibbonControl)
    Call MRange.GetNum
End Sub

函数实现：

代码语言：javascript复制

Sub GetNum()
    Dim selectRng As Range
    Dim arr As Variant
    Dim i As Long, j As Long
    Dim rngout As Range
    
    '确保选中的是单元格
    If TypeName(Selection) = "Range" Then
        Set selectRng = Selection
        If selectRng.Areas.Count > 1 Then
            MsgBox "未处理多重区域情况"
            Exit Sub
        End If
        
        On Error Resume Next
        '输出单元格默认是所选单元格的右边一列
        Set rngout = Application.InputBox("请选择输出的起始单元格，范围程序会自动扩展并覆盖原单元格内容。", Default:=selectRng.Range("A1").Offset(0, 1).Address, Type:=8)
        On Error GoTo 0
        If rngout Is Nothing Then Exit Sub
        
        If selectRng.Cells.Count = 1 Then
            rngout.Value = FGetnum(VBA.CStr(selectRng.Value))
        Else
            arr = selectRng.Value
            
            For i = 1 To UBound(arr, 1)
                For j = 1 To UBound(arr, 2)
                    arr(i, j) = FGetnum(VBA.CStr(arr(i, j)))
                Next
            Next
            
            rngout.Resize(i - 1, j - 1).Value = arr
        End If
 
    End If
    
    Set selectRng = Nothing
End Sub

Function FGetnum(str As String) As Double
    Dim i As Long
    For i = 1 To VBA.Len(str)
        '找到第一个是数字的位置
        If VBA.IsNumeric(VBA.Mid$(str, i, 1)) Then
            '使用Val函数转换
            FGetnum = VBA.Val(VBA.Mid$(str, i))
            Exit Function
        End If
    Next
End Function

程序主要是使用了内置的Val函数，只要找到首个出现数字的位置，提取这个数字之后的所有文本，用Val函数进行转换。

程序能处理多种情况，但是仅仅提取首次出现的一块数字。

vba 数据处理

0 人点赞