在保留格式的同时从单元格末尾删除换行符

时间:2018-01-18 21:43:20

标签: excel vba excel-vba

我有几个工作表,包含数百个文本单元。工作表需要很好地格式化以便打印。这些单元中的一些在单元末端具有换行符,有时多于一行。当我自动调整行(使用宏)时,自动调整大小会考虑这些换行符,并且存在相当大的空白,这对于打印是不可接受的。

我需要以某种方式从单元格底部开始在每个单元格内执行搜索并删除任何换行符(如果有)(CHR(10),vbCrLf等),但仅在第一次非换行符之前删除到达角色,在单元格中没有其他地方。

我不能使用replace(),trim()或类似的函数,因为单元格包含重要的格式,这些格式将被这些函数丢失。

例如:

  

这是我的文字。

     

vbCrLf

     

这是加粗

     

vbCrLf

     

这是斜体

     

vbCrLf

     

vbCrLf

我需要删除单元格末尾的最后两个vbCrLf,保留粗体和斜体文本的格式,并且要删除单元格中没有其他vbCrLf。

我已经广泛搜索了合适的答案,但没有找到满足我所有需求的答案。任何帮助将不胜感激!

1 个答案:

答案 0 :(得分:5)

修改单元格内容而不影响任何文本格式的方法是使用Characters集合:

Sub RemoveTrailingLineBreaks()
    Dim c As Range
    For Each c In Selection.Cells
        Do While Right(c.Value, 1) = vbLf Or Right(c.Value, 1) = vbCr
            c.Characters(Len(c.Value), 1).Delete
        Loop
    Next c
End Sub

编辑:使用Characters集合时,对于> 255长度问题没有整齐的解决方法。这非常笨重而且很慢,但确实有效:

Sub Tester()
    RemoveTrailingLineBreaks Range("A1")
End Sub


Sub RemoveTrailingLineBreaks(r As Range)

    Dim info()
    Dim i As Long, n As Long, txt

    Set r = Range("A1") '<< long formatted text with trailing linebreaks

    txt = r.Value
    Do While Right(txt, 1) = vbLf Or Right(txt, 1) = vbCr
        txt = Left(txt, Len(txt) - 1)
        n = n + 1
    Loop
    If n = 0 Then Exit Sub 'exit if no trailing new lines
    ReDim info(1 To Len(txt), 1 To 4)
    'collect the format info...
    For i = 1 To Len(txt)
        With r.Characters(i, 1).Font
            info(i, 1) = .Bold
            info(i, 2) = .Italic
            info(i, 3) = .Size
            info(i, 4) = .Color
        End With
    Next i

    r.Value = txt
    're-apply format info...
    Application.ScreenUpdating = False
    For i = 1 To Len(txt)
        With r.Characters(i, 1).Font
            .Bold = info(i, 1)
            .Italic = info(i, 2)
            .Size = info(i, 3)
            .Color = info(i, 4)
        End With
    Next i
    Application.ScreenUpdating = True

End Sub