减少单元格中的换行次数/ chr(10)

时间:2019-05-31 22:22:21

标签: excel vba excel-vba excel-formula newline

我有一个excel工作表,其中的单元格具有不同数量的换行符,并且我想减少它,以便每行之间只有一个换行符。

例如

HELLO




WORLD



GOODBYE

将修改为:

HELLO 

WORLD

GOODBYE

我已经花了几个小时来思考,并提出了几种方法,但是没有一种是非常有效的或无法产生最佳效果的。

这特别困难,因为我正在使用在换行符之前有空格的数据集。

enter image description here

因此常规解析也不起作用。

我试图用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不可能做到这一点。

如果有人足够帮助我调整当前代码或通过上述伪代码协助我,将不胜感激!

4 个答案:

答案 0 :(得分:3)

您可以使用公式进行操作

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

这会将所有空格更改为|,然后将Char(10)更改为空格。修剪可消除多余的空间。我们将空格反转为Char(10),将|反转为空格。

enter image description here


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

enter image description here

答案 1 :(得分:1)

您可以使用正则表达式。

下面的正则表达式模式删除包含零到任意数量空格的任何行及其终止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阵列上运行该过程以提高速度。

答案 2 :(得分:0)

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是“ LineFeed”的常量。新行有多种类型,例如vbCr(回车)或vbCrLf(组合)。在单元格中按 Alt + Enter 似乎使用了vbLf变体,这就是为什么我在其他变量上使用此常量的原因。

答案 3 :(得分:0)

这已经被很好地回答了,但是还不满足其中一项要求(每行之间有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

很高兴在需要时提供进一步的帮助。