我:
Clean
功能删除任何文本的所有格式,下面的代码就像一个冠军,但它是残酷的;
代码
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
答案 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个部分之前,我使用了一个简单的布尔值来测试。