刪除所選單元格中的空行

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