在Excel 2010中将单元格内容划分为单独的行

时间:2016-06-25 23:38:12

标签: excel vba excel-vba excel-formula

我试图将长度大于72的单元格内容拆分成单独的行,其长度不超过72个字符。我无法完成这个逻辑,需要帮助。 这里的特殊挑战是每个单元格的内容是一个完整的句子并且没有分隔符,所以我只需要在单词结束时分割语句,并且每个单元格保留长度为72个字符且不超过该单词。

有什么建议吗?

谢谢

2 个答案:

答案 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

使用原始帖子作为一个单元格中的数据的示例:

enter image description here

以下是有关线分割正则表达式的解释和链接,因为它将以72个字符的行长度呈现。

\ S {0,71}(= \ S |?$)| \ S {72,}

\S.{0,71}(?=\s|$)|\S{72,}

选项:区分大小写; ^ $匹配换行符(在此实例中无关)

使用RegexBuddy

创建

编辑根据原始海报的要求,添加了一个例程,循环遍历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

enter image description here