如何从Excel中的单元格删除空行（VBA）

下面是我试图通过工作表中的所有单元格，包含一个string，到目前为止有限的成功：

| 示例|
cell1_empty_line
cell1_text1
cell1_empty_line
+ ——————— +
cell2_text1
cell2_emptyline
cell2_text2
+ ——————— +
cell3_emptyline
cell3_emptyline
cell3_text1
+ ——————— +

| 预期结果|
cell1_text1
+ ——————— +
cell2_text1
cell2_text2
+ ——————— +
cell3_text1
+ ——————— +

任何这样的macros的build议？

非常感谢。

Answer 1

使用此macros删除所有单元格内的空行：

Sub TrimEmptyLines() Dim cel As Range, s As String, len1 As Long, len2 As Long For Each cel In ActiveSheet.UsedRange If Not IsError(cel.Value2) Then If InStr(1, cel.text, vbLf) > 0 Then s = Trim(cel.Value2) Do ' remove duplicate vbLf len1 = Len(s) s = Replace$(s, vbLf & vbLf, vbLf) len2 = Len(s) Loop Until len2 = len1 ' remove vblf at beginning or at end If Left$(s, 1) = vbLf Then s = Right$(s, Len(s) - 1) If Right$(s, 1) = vbLf Then s = Left$(s, Len(s) - 1) cel.value = Trim$(s) End If End If Next End Sub 

Answer 2

如果你正在谈论给定单元格内的空行，那么其中一个应该工作：

Cells.Replace what：= Chr（13），Replacement：=“”，LookAt：= xlPart

Cells.Replace what：= Chr（10），Replacement：=“”，LookAt：= xlPart

Answer 3

这通常足以处理每个单元格中的任意行换行的任何列单元格。 它假设所有的值都在活动表的第1行的列“A”中：

 Public Function RemoveDoubleLfs(str As String) As String If InStr(str, vbLf & vbLf) > 0 Then str = RemoveDoubleLfs(Replace(str, vbLf & vbLf, vbLf)) End If RemoveDoubleLfs = str End Function Sub RemoveEmptyLines() Dim i As Integer, lastRow As Integer lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row ' Dim val As String For i = 1 To lastRow: val = Cells(i, "A").Value If InStr(1, val, vbLf) > 0 Then val = RemoveDoubleLfs(val) If Left(val, 1) = vbLf Then val = Right(val, Len(val) - 1) If Right(val, 1) = vbLf Then val = Left(val, Len(val) - 1) Cells(i, "A").Value = val End If Next ActiveSheet.Rows.EntireRow.AutoFit End Sub 

recursionreplace函数删除单元格文本中的双行换行符。 一旦完成，string的开头和结尾最多只有一个VbLf。 最后两条if语句查找并删除后者。

最后的autofit是可选的，纯粹是为了美化结果。 它只是将细胞压缩到最小高度。

Answer 4

在实施这个解决scheme之前，请在上面设置两个variables的值。

 FirstDataColumn = 1 FirstDataRow = 2 

此设置将从第一列开始，但不包含可能包含列标题的第一行。

Sub RemoveBlanks（）

 Dim FirstDataColumn As Long, FirstDataRow As Long Dim LastColumn As Long, LastRow As Long Dim Tmp As Variant, Arr As Variant Dim Counter As Integer Dim C As Long, R As Long FirstDataColumn = 1 FirstDataRow = 2 Application.ScreenUpdating = False With ActiveSheet With .UsedRange LastColumn = .Columns.Count LastRow = .Rows.Count End With For C = FirstDataColumn To LastColumn ReDim Arr(LastRow, 0) Counter = 0 For R = FirstDataRow To LastRow Tmp = Trim(.Cells(R, C).Value) If Len(Tmp) Then Arr(Counter, 0) = Tmp Counter = Counter + 1 End If Next R .Cells(FirstDataRow, C).Resize(LastRow, 1).Value = Arr Next C End With Application.ScreenUpdating = True 

结束小组