使用VBA自定义函数将文字拆分为完整的部分

fanjy

发布于 2024-01-30 12:43:55

1450

发布于 2024-01-30 12:43:55

文章被收录于专栏：完美Excel完美Excel

标签：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函数的代码如下：

'将文本拆分为多个部分的自定义函数
'单词是不间断的，可以指定每个部分的最大字符数
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为每部分最大的字符数。

本文参与?腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2024-01-29，如有侵权请联系?cloudcommunity@tencent.com 删除

vba