从选定的单元格中删除空行答案

【问题标题】：Remove empty lines from selected cells从选定的单元格中删除空行
【发布时间】：2015-11-10 15:37:56
【问题描述】：

我正在尝试从 Excel 中的单元格中仅删除空行。这是我想要实现的目标：

+-----------------+    +---------------------+    +---------------------+
|  EXAMPLE DATA   |    |    EXPLANATION      |    |   EXPECTED RESULT   |
+-----------------+    +---------------------+    +---------------------+
| cell1_text1     |    | cell1_text1         |    | cell1_text1         |
| cell1_text2     |    | cell1_text2         |    | cell1_text2         |
+-----------------+    +---------------------+    +---------------------+
|                 |    | cell2_empty_line    |    | cell2_text1         | 
| cell2_text1     |    | cell2_text1         |    +---------------------+ 
+-----------------+    +---------------------+    | cell3_text1         | 
| cell3_text1     |    | cell3_text1         |    | cell3_text2         | 
|                 |    | cell3_emptyline     |    +---------------------+ 
| cell3_text2     |    | cell3_text2         |    | cell4_text1         | 
+-----------------+    +---------------------+    +---------------------+ 
|                 |    | cell4_emptyline     |    | cell5_text1         | 
|                 |    | cell4_emptyline     |    +---------------------+ 
| cell4_text1     |    | cell4_text1         |    | cell6_text1         | 
+-----------------+    +---------------------+    | cell6_text2         | 
| cell5_text1     |    | cell5_text1         |    | cell6_text3         | 
+-----------------+    +---------------------+    | cell6_text4         | 
| cell6_text1     |    | cell6_text1         |    +---------------------+ 
| cell6_text2     |    | cell6_text2         |
| cell6_text3     |    | cell6_text3         |
|                 |    | cell6_emptyline     |
| cell6_text4     |    | cell6_text4         |
+-----------------+    +---------------------+

我有found this script:

Sub RemoveCarriageReturns()
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each MyRange In ActiveSheet.UsedRange
        If 0 < InStr(MyRange, Chr(10)) Then
            MyRange = Replace(MyRange, Chr(10), "")
        End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

但它没有给我想要的结果，它删除了所有单元格中的所有断线。

+---------------------------------------------+
|          CURRENT SCRIPT RESULT              |
+---------------------------------------------+
| cell1_text1cell1_text2                      |
+---------------------------------------------+
| cell2_text1                                 |
+---------------------------------------------+
| cell3_text1cell3_text2                      |
+---------------------------------------------+
| cell4_text1                                 |
+---------------------------------------------+
| cell5_text1                                 |
+---------------------------------------------+
| cell6_text1cell6_text2cell6_text3cell6_text4|
+---------------------------------------------+

如何测试行是否不包含任何其他字母并仅删除单元格中的该行？如何将该宏仅应用于当前选定的单元格？

【问题讨论】：

你只有一个可以在-----------------行之间移动值吗？

标签： vba excel

【解决方案1】：

您需要找到并删除错误的换行符（例如 vbLF、Chr(10) 或 ASCII 010 dec）。如果数据是从外部来源复制的，则流氓回车符（例如 vbCR 或 Chr(13)）可能会被捎带，这些也应该被清除。

Sub clean_blank_lines()
    Dim rw As Long
    
    With Worksheets("Sheet3")   '<~~SET THIS WORKSHEET REFERENCE PROPERLY!
        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            With .Cells(rw, 1)
                .Value = Replace(.Value2, Chr(13), Chr(10))
                Do While Left(.Value2, 1) = Chr(10): .Value = Mid(.Value2, 2): Loop
                Do While CBool(InStr(1, .Value, Chr(10) & Chr(10)))
                    .Value = Replace(.Value2, Chr(10) & Chr(10), Chr(10))
                Loop
                Do While Right(.Value2, 1) = Chr(10): .Value = Left(.Value2, Len(.Value2) - 1): Loop
            End With
            .Rows(rw).EntireRow.AutoFit
        Next rw
    End With
End Sub

在完成的单元格上执行Range.AutoFit 以删除死“空白”。

_之前 _之后

要将其转换为处理一个或多个选定单元格的宏，请参阅How to avoid using Select in Excel VBA macros 中的Examples of Selection-based sub framework。

【讨论】：

【解决方案2】：

这样就可以了：

不要替换回车符，而是拆分它，然后循环遍历并仅用那些具有值的项目替换值。

Sub RemoveCarriageReturns()
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each MyRange In ActiveSheet.UsedRange
        Dim textArr() As String
        textArr = Split(MyRange.Value, Chr(10))
        MyRange.Value = ""
        For i = LBound(textArr) To UBound(textArr)
            If textArr(i) <> "" Then
                If MyRange.Value = "" Then
                    MyRange.Value = textArr(i)
                Else
                    MyRange.Value = MyRange.Value & Chr(10) & textArr(i)
                End If
            End If
        Next i
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

【讨论】：