Reducing number of Line Breaks/chr(10) in a Cell

问题

I have an excel sheet that has cells with variable amounts of line breaks and I want to reduce it so that there is only one line break between each new line.

For example

HELLO




WORLD



GOODBYE

will be modified to:

HELLO 

WORLD

GOODBYE

I've been banging my head over this for hours and have come up with a few ways but none are very efficient or produce the best results.

This is made especially difficult because I'm working with a dataset that has spaces preceeding the Line Breaks.

And so a regular parse doesn't work as well.

I've tried to replace all the instances of chr(10) in the cell with ~ to make it easier to work with, however i'm still not getting it to an exact amount. I'm wondering if there are better ways.

here is what I have so far:

 myString = Replace(myString, Chr(10), "~")

    Do While InStr(myString, "~~") > 0
        str1 = Split(myString, "~")
        For k = 0 To UBound(str1)
        myString = Replace(myString, "~~", "~")
        Next k
    Loop

    Do While InStr(myString, "   ~") > 0
        str1 = Split(myString, "~")
        For k = 0 To UBound(str1)
        myString = Replace(myString, "  ~", "")
        Next k
    Loop

myString = Replace(myString, "   ~", " ~")
myString = Replace(myString, " ~", "~")
myString = Replace(myString, "~", Chr(10))

Cells(2, 2).Value = myString

So i'm using a few do while loops to catch instances of different types of line breaks (or in this case, tildes) but I don't think this is the best way to tackle this.

I was thinking of ways to loop through the characters in the cell, and if there is an instance where there is more than one chr(10), replace it with "".

So the psuedocode would look like:

for i to len(mystring)
    if mystring(i) = chr(10) AND myString(i+1) = chr(10) Then
       myString(i + 1) = ""

but unfortunately I don't think this is possible through vba.

If anyone is kind enough to help me adjust my current code or assist me with the aforementioned psuedocode, it would be greatly appreciated!

回答1:

You can do it with a formula:

=SUBSTITUTE(SUBSTITUTE(TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(TRIM(A1)," ","|"),"|"&CHAR(10)," "),CHAR(10)," "))," ",CHAR(10)),"|"," ")

This changes all the spaces to | and then the Char(10) to spaces. The trim removes the extra spaces. The we reverse, space to Char(10) and | to spaces.

---

VBA:

Function manytoone(str As String)
    str = Replace(Application.Trim(str), " ", "|")
    str = Replace(str, "|" & Chr(10), " ")
    str = Replace(str, Chr(10), " ")
    str = Application.Trim(str)
    str = Replace(str, " ", Chr(10))
    str = Replace(str, "|", " ")
    manytoone = str

End Function

回答2:

You can use Regular Expressions.

The regex pattern below removes any line that contains zero to any number of spaces, along with its terminating crlf, and also removes the crlf at the end of the final word.

Option Explicit
Sub trimXSLF()
    Dim myRng As Range, myCell As Range, WS As Worksheet
    Dim RE As Object
    Const sPat As String = "^\s*[\x0A\x0D]+|[\x0A\x0D](?!\s*\S+\s*)"
    Const sRepl As String = ""

Set WS = Worksheets("sheet4") 'or whatever
With WS
    Set myRng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .MultiLine = True
    .Pattern = sPat

    For Each myCell In myRng
        myCell = .Replace(myCell.Value2, sRepl)
    Next myCell

End With
End Sub

If myRng is large (tens of thousands of rows), the macro could run the process over a VBA array for speed.

回答3:

A VBA method would be replacing consecutive vbLf constants with a single one.

Loop through the string as long as there are more than one vbLf together, once removed, replace the string.

Sub RemoveExcessLinebreaks()

    Dim s As String, rng As Range
    Set rng = ThisWorkbook.Worksheets(1).Range("B4")
    s = rng.Value

    While InStr(1, s, vbLf & vbLf) > 0
        s = Replace(s, vbLf & vbLf, vbLf)
    Wend

    rng.Value = s

End Sub

Obviously, you would need to modify the rng object to your purposes, or turn it into a parameter to the sub itself.

vbLf is a constant for a "LineFeed". There are multiple types of new lines, such as a vbCr (Carriage Return) or a vbCrLf (combined). Pressing Alt + Enter in a cell appears to use the vbLf variant, which is why I used this constant over the others.

回答4:

This has already been answered fairly well, but not meeting one of the requirements yet (have 1 line between each new line), so here is my take on answering this. Please see the comments through the code for more details:

Option Explicit

Sub reduceNewLines()

Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets("Sheet1")
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim lCol As Long: lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Dim arrData As Variant: arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol))
Dim arrVal() As String
Dim R As Long, C As Long, X As Long

For R = LBound(arrData) To UBound(arrData) 'Iterate through each row of data
    For C = LBound(arrData, 2) To UBound(arrData, 2) 'iterate through each column of data (though might be just 1)

        arrVal = Split(arrData(R, C), Chr(10)) 'allocate each row to an array, split at new line

        arrData(R, C) = "" 'reset the data inside this field

        For X = LBound(arrVal) To UBound(arrVal)
            arrVal(X) = Trim(arrVal(X)) 'clear leading/trailing spaces
            If Left(arrVal(X), 1) <> " " And arrVal(X) <> "" Then
                arrData(R, C) = arrData(R, C) & arrVal(X) & Chr(10) & Chr(10) 'allocate new data + 2 lines
            End If
        Next X

        arrData(R, C) = Left(arrData(R, C), Len(arrData(R, C)) - 2) 'remove the last 2 extra new lines
    Next C
Next R

ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) = arrData 'allocate the data back to the sheet

End Sub

Happy to assist further if needed.

来源：https://stackoverflow.com/questions/56402311/reducing-number-of-line-breaks-chr10-in-a-cell