删除所选单元格中的空行

Question

我想从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| 
+---------------------------------------------+ 

如何测试，如果行不包含任何其他字母和细胞内只删除该行？ 如何将该宏仅应用于当前选定的单元格？

Answer 1

您需要找到并删除错误的换行字符（例如vbLF，Chr(10)或ASCII 010分解）。如果数据是从外部源复制的，那么可能会出现流氓回车符（例如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 macrosExamples of Selection-based sub framework。

Answer 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