标签：VBA，自定义函数
这是wimgielis.com发表的一个VBA自定义函数，能够完整地提取句子的一部分，而不会截断单词。
例如，单元格A1中的文本为：
This is a stupid example sentence to explain the SplitText function
公式：
=SplitText(A1,1,20)
返回：
This is a stupid
公式：
=SplitText(A1,2,20)
返回：
example sentence to
公式：
=SplitText(A1,3,20)
返回：
explain the
公式：
=SplitText(A1,4,20)
返回：
SplitText function
SplitText函数的代码如下：
代码语言：javascript复制'将文本拆分为多个部分的自定义函数
'单词是不间断的，可以指定每个部分的最大字符数
Function SplitText(str As String, iPart As Byte, iMaxChars As Integer) As String
Dim arrWords As Variant
Dim iWordCounter As Integer
Dim j As Integer
Dim iPartCounter As Integer
Dim sConcatTemp As String
If iPart < 1 Then
SplitText = "iPart值至少是1"
Exit Function
End If
SplitText = ""
If str <> "" Then
str = Trim(str)
str = Replace(Replace(str, Chr(32), " "), Chr(160), " ")
str = Replace(str, " ", " ")
arrWords = Split(str)
ReDim Preserve arrWords(UBound(arrWords) 1)
arrWords(UBound(arrWords)) = "a" '虚设以避免以后出现错误消息
iPartCounter = 1
j = 0
Do While iPartCounter <= iPart
iWordCounter = 0
sConcatTemp = ""
Do While Len(sConcatTemp) - 1 <= iMaxChars And j iWordCounter < UBound(arrWords)
sConcatTemp = sConcatTemp & " " & arrWords(j iWordCounter)
iWordCounter = iWordCounter 1
Loop
If Len(sConcatTemp) - 1 > iMaxChars Then iWordCounter = iWordCounter - 1
If iPartCounter = iPart Then
If Len(sConcatTemp) - 1 > iMaxChars Then
SplitText = Trim(Left(sConcatTemp, Len(sConcatTemp) - Len(arrWords(j iWordCounter))))
Else
SplitText = Trim(sConcatTemp)
End If
End If
iPartCounter = iPartCounter 1
If j iWordCounter = UBound(arrWords) Then Exit Function
j = j iWordCounter
Loop
End If
End Function其中，参数str为要拆分的字符串；参数iPart为想要获取拆分后的哪部分；参数iMaxChars为每部分最大的字符数。
