VBA切割string，最后一个字长度小于80个字符

我是：

• 使用Excel Cleanfunction去除任何文本的所有格式化
• 那么我想把产生的长string分成80个或更less的字符。
• 干净之后剩余的唯一分隔符是空格。

下面的代码是这样的，像冠军，但它是残酷的;

码

 Sub TrimTo75() myRow = 4 Range("C" & myRow).Select myString = ActiveCell.Value While myString <> "" While Len(myString) > 75 mySubString = Left(myString, 75) ActiveCell.Value = mySubString myString = Right(myString, Len(myString) - 75) myRow = myRow + 1 Range("C" & myRow).Select Application.CutCopyMode = False Selection.Insert Shift:=xlDown If Len(myString) < 75 Then ActiveCell.Value = myString End If Wend myRow = myRow + 1 Range("C" & myRow).Select myString = ActiveCell.Value Wend End Sub 

Answer 1

尝试这个 ..

 Sub TrimTo75() myRow = 4 Range("C" & myRow).Select myString = ActiveCell.Value Dim x As Integer While myString <> "" While Len(myString) >= 75 x = 75 While Not Mid(myString, x, 1) = " " x = x - 1 Wend MsgBox x 'mySubString = Left(myString, 75) mySubString = Left(myString, x) ActiveCell.Value = mySubString 'myString = Right(myString, Len(myString) - 75) myString = Mid(myString, x + 1) myRow = myRow + 1 Range("C" & myRow).Select Application.CutCopyMode = False Selection.Insert Shift:=xlDown If Len(myString) < 75 Then ActiveCell.Value = myString End If Wend myRow = myRow + 1 Range("C" & myRow).Select myString = ActiveCell.Value Wend End Sub 

Answer 2

此代码使用正则Regex和变体数组来快速parsing

它取自C4:Cx的范围，并把块放在D4

 Sub QuickStrip() Dim Regex As Object Dim RegexMC As Object Dim RegexM As Object Dim lngCnt As Long Dim lngOut As Long X = Range([c4], Cells(Rows.Count, "C").End(xlUp)) Application.ScreenUpdating = False Set Regex = CreateObject("vbscript.regexp") With Regex .Pattern = "[\w\s]{1,79}([^\w]|$)" .Global = True For lngCnt = 1 To UBound(X) If .test(X(lngCnt, 1)) Then Set RegexMC = .Execute(X(lngCnt, 1)) For Each RegexM In RegexMC [d4].Offset(lngOut, 0) = RegexM lngOut = lngOut + 1 Next End If Next End With Application.ScreenUpdating = True End Sub 

Answer 3

 If Len(rngCellsB_Title) > 90 Then x = 90 While Not Mid(rngCellsB_Title, x, 1) = " " x = x - 1 Wend strFirstPart = Left(rngCellsB_Title, x) strSecondPart = Right(rngCellsB_Title, (Len(rngCellsB_Title) - x)) blnSplit = True End If If blnSplit Then strMessageTemp = strFirstPart & strSecondPart & Chr(13) blnSplit = False Else strMessageTemp = rngCellsB_Title & Chr(13) End If 

试试这个，它只是将一个已知点之前的string拆分，使用空间作为demiliter。 我使用一个简单的布尔值来testing之前处理整个string，或它的2个部分。