VBA学习(35)：字符串函数Split的妙用

最近做了一个批处理小程序，Split函数立了大功劳。分享给大家其中的思路和知识点。

→案例需求：

将下图1中B列句子，按空格、标点符号分割开，单独列为1行。

图1

图2

→思路分析：

首先就想到用Split函数，以空格作为分隔符号把英文句子分割开。我们先熟悉下Split函数。

●使用方法：Split(需要分割的字符串,分隔符)

通俗的说：Split 函数给他一个分隔符，能把字符串分割开，并返回一个下标从零开始的一维数组。（重点：①下标从0开始②一维数组）

仿佛可以解决问题了，但是还有一个条件：句子中除了空格，标点符号也要做为分隔符。

Split只能设置一种分隔符，如何实现多种分隔符实现成功分割字符串呢？

●解决办法：

我们在使用Split函数之前，把其他的标点符号，全部替换为空格即可。这样子，可以一次性实现分以空格作为分隔符分割字符串。

→最终代码：

里面除了数组转置自定义函数可以借鉴，其他的都是上面编程逻辑的体现，理解了上面说的，下面的东西很简单。

Sub test()
    Dim crr()
    k = 0
    Set sht2 = Worksheets("原始数据")
    arr = Intersect(sht2.UsedRange, sht2.Cells)
    For i = 2 To UBound(arr)
        brr = Split(replacestr(arr(i, 2)), " ") '以空格作为分隔符，分割字符串
        For j = 0 To UBound(brr) '分割完成，循环写入数组crr
            k = k + 1
            ReDim Preserve crr(1 To UBound(arr, 2), 1 To k)
            For m = 1 To UBound(arr, 2) 'For循环，将英文句子同一行的内容写入数组Crr
                crr(m, k) = arr(i, m)
            Next
            crr(2, k) = brr(j)
        Next
    Next
    '//开始写入结果
    Set sht = Worksheets("结果")
    sht.UsedRange.Clear '清空原有数据
    Worksheets("原始数据").Rows(1).Copy sht.Range("a1")
    sht.Range("a2").Resize(UBound(crr, 2), UBound(crr)) = Transpose2(crr)
    sht.Columns.AutoFit
    MsgBox ("完成！")
End Sub
Function replacestr(strr)
    '自定义函数，替换标点符号为空格，为下一步
    '用空格分割句子做准备
    replacestr = Replace(strr, ",", " ,")
    replacestr = Replace(replacestr, ".", " .")
    replacestr = Replace(replacestr, """", " "" ")
    replacestr = Replace(replacestr, "?", " ? ")
    replacestr = Trim(replacestr)
End Function

数组转置自定义函数：

Function Transpose2(arr As Variant)
'自定义数组转置函数，突破工作表函数Transpose的限制
    Dim brr(), i, j, n
    n = NumberOfArrayDimensions(arr)
    If n = 1 Then
        ReDim brr(LBound(arr) To UBound(arr), 1 To 1)
        For i = LBound(arr) To UBound(arr)
            brr(i, 1) = arr(i)
        Next
    Else
        ReDim brr(LBound(arr, 2) To UBound(arr, 2), LBound(arr) To UBound(arr))
        For i = LBound(arr) To UBound(arr)
            For j = LBound(arr, 2) To UBound(arr, 2)
                brr(j, i) = arr(i, j)
            Next
        Next
    End If
    Transpose2 = brr
End Function
Public Function NumberOfArrayDimensions(arr As Variant) As Integer
    Dim Ndx As Integer
    Dim Res As Integer
    On Error Resume Next
    Do
        Ndx = Ndx + 1
        Res = UBound(arr, Ndx)
    Loop Until Err.Number <> 0
    NumberOfArrayDimensions = Ndx - 1
End Function

 

 技术交流，软件开发，欢迎微信沟通：