string - 最后一个单词后的VBA切割字符串总长度小于80个字符

Question

我是：

• 使用 ExcelClean函数去除任何文本的所有格式，以及
• 然后我想将生成的长字符串分成不超过 80 个字符的单独行。
• 清理后唯一剩下的分隔符是空格。

下面的代码就像一个冠军，但它是残酷的；

代码

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和一个变体数组进行快速解析

它需要一个范围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

试试这个，它只是在已知点之前使用空格作为分隔符拆分字符串。在处理整个字符串或其中的 2 个部分之前，我使用了一个简单的布尔值进行测试。