我试图将长度大于72的单元格内容拆分成单独的行,其长度不超过72个字符。我无法完成这个逻辑,需要帮助。 这里的特殊挑战是每个单元格的内容是一个完整的句子并且没有分隔符,所以我只需要在单词结束时分割语句,并且每个单元格保留长度为72个字符且不超过该单词。
有什么建议吗?
谢谢
答案 0 :(得分:4)
您可以使用正则表达式执行此操作。尝试使用我之前写的这个宏来适应您的特定要求:如果一个单词恰好比w
个字符更长,它会溢出 - 可能不是72个字符行长度的问题;但你可以通过改变正则表达式来改变这种行为。
如上所述,宏将分割文本写入原始文本下方的单元格中。
Sub WordWrap()
'requires reference to Microsoft VBScript Regular Expressions 5.5
'Wraps at W characters, but will allow overflow if a word is longer than W
Dim RE As RegExp, MC As MatchCollection, m As Match
Dim str As String
Dim w As Long
Dim rSrc As Range, C As Range
Dim mBox As Long
Dim I As Long
'with offset as 1, split data will be below original data
'with offset = 0, split data will replace original data
Const lDestOffset As Long = 1
Set rSrc = Selection
If rSrc.Rows.Count <> 1 Then
MsgBox ("You may only select" & vbLf & " Data in One (1) Row")
Exit Sub
End If
Set RE = New RegExp
RE.Global = True
w = InputBox("Maximum characters in a Line: ", , 72)
If w < 1 Then w = 79
For Each C In rSrc
str = C.Value
'remove all line feeds and nbsp
RE.Pattern = "[\xA0\r\n\s]+"
str = RE.Replace(str, " ")
RE.Pattern = "\S.{0," & w - 1 & "}(?=\s|$)|\S{" & w & ",}"
If RE.Test(str) = True Then
Set MC = RE.Execute(str)
'see if there is enough room
I = lDestOffset + 1
Do Until I > MC.Count + lDestOffset
If Len(C(I, 1)) <> 0 Then
mBox = MsgBox("Data in " & C(I, 1).Address & " will be erased if you contine", vbOKCancel)
If mBox = vbCancel Then Exit Sub
End If
I = I + 1
Loop
I = lDestOffset
For Each m In MC
C.Offset(I, 0).Value = m
I = I + 1
Next m
End If
Next C
Set RE = Nothing
End Sub
使用原始帖子作为一个单元格中的数据的示例:
以下是有关线分割正则表达式的解释和链接,因为它将以72个字符的行长度呈现。
\S.{0,71}(?=\s|$)|\S{72,}
选项:区分大小写; ^ $匹配换行符(在此实例中无关)
\S.{0,71}(?=\s|$)
\S{72,}
编辑根据原始海报的要求,添加了一个例程,循环遍历A列中的单元格,将拆分结果放入B列。一些原始代码,允许线路长度和信号源选择的选择是硬编码的。
Option Explicit
Sub WordWrap2()
'requires reference to Microsoft VBScript Regular Expressions 5.5
'Wraps at W characters, but will allow overflow if a word is longer than W
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim str As String
Const W As Long = 72
Dim rSrc As Range, C As Range
Dim vRes() As Variant
Dim I As Long
'Set source to column A
Set rSrc = Range("A1", Cells(Rows.Count, "A").End(xlUp))
Set RE = New RegExp
RE.Global = True
I = 0
For Each C In rSrc
str = C.Value
'remove all line feeds and nbsp
RE.Pattern = "[\xA0\r\n\s]+"
str = RE.Replace(str, " ")
RE.Pattern = "\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"
If RE.Test(str) = True Then
Set MC = RE.Execute(str)
ReDim Preserve vRes(1 To MC.Count + I)
For Each M In MC
I = I + 1
vRes(I) = M
Next M
Else 'Allow preservation of blank lines in source data
I = I + 1
End If
Next C
'if ubound(vres) > 16384 then will need to transpose in a loop
vRes = WorksheetFunction.Transpose(vRes)
With Range("B1").Resize(UBound(vRes, 1))
.EntireColumn.Clear
.Value = vRes
.EntireColumn.AutoFit
End With
Set RE = Nothing
End Sub
答案 1 :(得分:1)
这个怎么样:
Sub Demo()
Dim str As String
Dim i As Long, rowIdx As Long
Dim myString As Variant
str = " "
myString = Split(Range("A1").Value)
rowIdx = 5 '-->row number from where data will be displayed
For i = LBound(myString) To UBound(myString)
If (Len(str) + Len(myString(i)) + 1) > 72 Then '-->check for length > 72
Range("A" & rowIdx).Value = Trim(str) '-->if > 72 display in cell
rowIdx = rowIdx + 1 '-->increment row index
str = "" 'set str="" to countinue for new line
End If
str = str & myString(i) & " "
Next
If Len(str) > 0 Then Range("A" & rowIdx).Value = Trim(str) 'display remiaing words
End Sub