Уменьшение количества разрывов строк / chr (10) в ячейке

Question

У меня есть лист Excel, в котором есть ячейки с переменным количеством разрывов строк, и я хочу уменьшить его, чтобы между каждой новой строкой был только один разрыв строки.

Например,

HELLO




WORLD



GOODBYE

будет изменено на:

HELLO 

WORLD

GOODBYE

Я часами ломал голову над этим и придумал несколько способов, но ни один из них не очень эффективен или не дает наилучших результатов.

Это особенно сложно, потому что я работаю с набором данных, у которого есть пробелы, предшествующие разрывам строк.

И поэтому обычный анализ не работает так же.

Я пытался заменить все экземпляры chr(10) в ячейке с ~, чтобы с ним было легче работать, однако я все еще не получаю точную сумму.Мне интересно, есть ли лучшие способы.

вот что у меня есть:

 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

Так что я использую несколько циклов do while, чтобы ловить экземпляры разных типов.разрывы строк (или в данном случае тильды), но я не думаю, что это лучший способ справиться с этим.

Я думал о способах циклически проходить по символам в ячейке, и если естьВ случае, когда существует более одного chr (10), замените его на "".

Так что псевдокод будет выглядеть так:

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

но, к сожалению, я не думаю, что этоможно через vba.

Если кто-нибудь проявит любезность, чтобы помочь мне скорректировать мой текущий код или помочь мне с вышеупомянутым псевдокодом, это будет с благодарностью!

Answer 1

Вы можете сделать это по формуле:

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

Это меняет все пробелы на |, а затем Char(10) на пробелы. Отделка убирает лишние пробелы. Мы обращаемся, пробел к Char(10) и | к пробелам.

---

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

Answer 2

Вы можете использовать регулярные выражения.

Приведенный ниже шаблон регулярного выражения удаляет любую строку, содержащую ноль для любого количества пробелов, вместе с завершающим символом crlf, а также удаляет crlf в конце последнего слова.

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

Если myRng большое (десятки тысяч строк), макрос может запустить процесс над массивом VBA для скорости.

Answer 3

На этот вопрос уже был получен достаточно хороший ответ, но он еще не удовлетворяет одному из требований (имейте 1 строку между каждой новой строкой), поэтому вот мой ответ на этот вопрос. Пожалуйста, смотрите комментарии через код для более подробной информации:

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

Рад помочь, если потребуется.

Answer 4

Метод VBA будет заменять последовательные vbLf константы на одну.

Циклически перебирать строку, пока существует более одного vbLf вместе, после удаления заменить строку.

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

Очевидно, вам нужно изменить объект rng для ваших целей или превратить его в параметр для самого сабвуфера.

vbLf - это константа для "перевод строки».Существует несколько типов новых строк, таких как vbCr (возврат каретки) или vbCrLf (вместе).При нажатии Alt + Enter в ячейке появляется вариант vbLf, поэтому я использовал эту константу над остальными.