VBA切割字符串后的总字长小于80个字符

时间:2013-06-23 05:56:06

标签: string excel vba character

我:

  • 使用Excel Clean功能删除任何文本的所有格式,
  • 然后我想将生成的长字符串分成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

3 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

此代码使用Regex和变量数组进行快速解析<​​/ p>

它需要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

答案 2 :(得分:0)

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个部分之前,我使用了一个简单的布尔值来测试。