vba - 在 Excel 2010 中将单元格内容分成单独的行

Question

我正在尝试将长度大于 72 的单元格内容拆分为单独的行，它们的长度不会增加超过 72 个字符。我无法通过这种逻辑来解决问题，需要帮助。
这里的特殊挑战是每个单元格的内容是一个完整的句子并且没有分隔符，所以我只需要在一个单词结束时分割语句并且每个单元格的长度为 72 个字符，并且不超过这个。

有什么建议么？

谢谢

Answer 1

您可以使用正则表达式来做到这一点。尝试调整我前段时间写的这个宏来满足您的特定要求:如果一个单词恰好比 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,}

选项:区分大小写； ^$ 匹配换行符(在这种情况下无关)

Match this alternative \S.{0,71}(?=\s|$)

Match a single character that is NOT a “whitespace character” \S

Match any single character that is NOT a line break character .{0,71}

Between zero and 71 times, as many times as possible, giving back as needed (greedy) {0,71}

Assert that the regex below can be matched, starting at this position (positive lookahead) (?=\s|$)

Match this alternative \s

Match a single character that is a “whitespace character” \s

Or match this alternative $

Assert position at the end of a line $

Or match this alternative \S{72,}

Match a single character that is NOT a “whitespace character” \S{72,}

Between 72 and unlimited times, as many times as possible, giving back as needed (greedy) {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