字符串函数Split的妙用
VBA说
共 2542字,需浏览 6分钟
·
2020-09-10 06:26
最近做了一个批处理小程序,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
【建议收藏】VBA说历史文章汇总 速码工具箱2.0发布,更强大的功能等你来体验! VBA会被Python代替吗? 代码存储美化工具测评-【VBE2019】 Excel和Word数据交互读取(生成合同)
评论