删除选定单元格的空行

我正试图从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 | +-----------------+ +---------------------+ 

我发现这个脚本 ：

 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| +---------------------------------------------+ 

我如何testing行是否不包含任何其他字母，并删除单元格内的行？ 我如何才能将该macros只应用于当前选定的单元格？

Answer 1

您需要find并删除错误的换行符（例如vbLF， Chr(10)或ASCII 010 dec）。 如果数据是从外部来源复制的，那么可能是stream氓回车字符（例如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以去除死空白区域。

_之前之前

要将其转换为处理一个或多个选定单元格的macros，请参阅如何避免在Excel VBAmacros中使用select中 的基于select的子框架示例 。

Answer 2

这将做到这一点：

而不是取代回车，拆分它然后循环，并将值replace只有具有值的项目。

 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