VBA Заменить только начальные и конечные разрывы строк

У меня есть следующий текст, хранящийся в переменной myStringVariable:

"


    About this item 
    This fits your . 
    Make sure this fits by entering your model number. 

"

Извините, мне пришлось использовать "" выше, чтобы отобразить начальные и отстающие разрывы строк, которые у меня есть в моих ячейках, которые генерируются с помощью макроса VBA.

Как избавиться от ведущих и отстающих разрывов строк, чтобы получить следующее:

    About this item 
    This fits your . 
    Make sure this fits by entering your model number. 

Я не уверен, как подойти к этому.

Редактировать:

Replace(myStringVariable, vbNewLine, "")

заменит все разрывы строк. Итак, мне нужно решение типа функции Trim, я думаю.

Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
0
0
595
4
Перейти к ответу Данный вопрос помечен как решенный

Ответы 4

Попробуйте это:

Sub GiveMeABreak()
    Dim c As String, cell As Range, s As String
    
    c = Chr(10)
    For Each cell In Selection
        s = cell.Value
        If Left(s, 1) = c Then
            s = Mid(s, 2)
        End If
        If Right(s, 1) = c Then
            s = Left(s, Len(s) - 1)
        End If
        cell.Value = s
    Next cell
    
End Sub

ПРИМЕЧАНИЕ:

Проверяются только начальные и конечные символы. Если есть несколько ведущих разрывов строки, будет удален только первый.

РЕДАКТИРОВАТЬ № 1:

Эта версия кода удалит все начальные и конечные разрывы строк:

Sub GiveMeABreak2()
    Dim c As String, cell As Range, s As String
    
    c = Chr(10)
    For Each cell In Selection
        s = cell.Value
        While Left(s, 1) = c
            s = Mid(s, 2)
        Wend
        While Right(s, 1) = c
            s = Left(s, Len(s) - 1)
        Wend
        cell.Value = s
    Next cell
    
End Sub

@Zanam Тогда измените мою логику, чтобы обработать ваш текст до того, как ваш макрос заполнит ячейки.

Gary's Student 18.12.2020 14:17

похоже, у меня есть несколько символов новой строки в начале и в конце

Zanam 18.12.2020 14:18

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

Zanam 18.12.2020 14:18

@Zanam, посмотри мою заметку

Gary's Student 18.12.2020 14:19

Я хорошо разбираюсь в вашем коде, кроме этой части: будет удалена только первая. Я вижу, у вас репутация 91k, поэтому удаление нескольких ведущих строк невозможно?

Zanam 18.12.2020 14:22

@Zanam См. мой РЕДАКТИРОВАТЬ # 1

Gary's Student 18.12.2020 14:33
Ответ принят как подходящий

Вот функция trimCHAR, которая работает аналогично функции TRIM в Excel, за исключением того, что вы можете указать символ, который нужно обрезать.

Он удалит все начальные и конечные char, а также любые удвоенные char в строке (оставив один char в строке, как TRIM делает с пробелами)

Function trimCHAR(ByVal S As String, char As String)
'similar to worksheet TRIM function except can specify character(s) to TRIM
  Dim RE As Object
  Dim I As Long

Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .multiLine = True

'need to do separately, otherwise multiple chars within will
'be removed
        .Pattern = char & "*$"
        S = .Replace(S, "") 'Remove extra chars at end of string
        .Pattern = char & "*([^" & char & "]" & char & ")*"
        S = .Replace(S, "$1") 'Remove extra chars at start of string or within
End With
trimCHAR = S

End Function

Оригинал

Использование на листе: =trimCHAR(cell_ref,CHAR(10))

в макросе вы можете использовать =trimChar(myStringVariable, vblf)

Результат

Отличный ответ! trimCHAR() новинка для меня.

Gary's Student 18.12.2020 14:47

@Gary'sStudent Спасибо, Гэри. Я написал его, чтобы имитировать аналогичную функцию в Power Query. Этот вопрос побудил меня закончить его, что я только что сделал с последним редактированием.

Ron Rosenfeld 18.12.2020 15:01

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

Gary's Student 18.12.2020 15:30

Следующая функция заменит все начальные и конечные символы новой строки и символы возврата каретки. Если хотите, добавьте в чек больше символов (например, пробел и табуляцию).

Function TrimNewline(s As String) As String
     
    Dim i As Long, firstchar As Long, lastChar As Long
    For i = 1 To Len(s)
        Dim c As String
        c = Mid(s, i, 1)
        If c <> vbCr And c <> vbLf Then
            If firstchar = 0 Then
                firstchar = i
            Else
                lastChar = i
            End If
        End If
    Next i
    TrimNewline = Mid(s, firstchar, lastChar - firstchar + 1)

End Function

Тест:

Sub test()
    Dim s As String
    s = vbCrLf & vbLf & vbCr & "(AAAAA" & vbCrLf & "BBB)" & vbCrLf & vbCrLf & vbCrLf
    Debug.Print "<" & TrimNewline(s) & ">"
End Sub

Может быть интересна следующая функция:

Function CleanTrim(ByVal Text As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
    ' https://excelfox.com/forum/showthread.php/155-Trim-all-Cells-in-a-Worksheet-VBA#post1092
    ' Code modified from that by Rick Rothstein
    Dim i As Long, CodesToClean As Variant
    CodesToClean = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
                         21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 127, 129, 141, 143, 144, 157)
    If ConvertNonBreakingSpace Then Text = Replace(Text, Chr(160), " ")
    For i = LBound(CodesToClean) To UBound(CodesToClean)
        If InStr(Text, Chr(CodesToClean(i))) Then Text = Replace(Text, Chr(CodesToClean(i)), "")
    Next i
    CleanTrim = Application.WorksheetFunction.Trim(Text)
End Function

Другие вопросы по теме