如何从 Excel (VBA) 中的单元格中删除空行

Question

这是我试图通过包含字符串的工作表中的所有单元格实现的目标，到目前为止取得的成功有限：

| 示例 |
cell1_empty_line
单元格1_文本1
cell1_empty_line
+---------------------+
单元格2_文本1
cell2_emptyline
单元格2_文本2
+---------------------+
cell3_emptyline
cell3_emptyline
单元格3_文本1
+---------------------+

| 预期结果 |
单元格1_文本1
+---------------------+
单元格2_文本1
单元格2_文本2
+---------------------+
单元格3_文本1
+---------------------+

对这样的宏有什么建议吗？

非常感谢。

Answer 1

使用此宏删除所有单元格内的任何空行：

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

递归替换函数消除了单元格文本中的双换行符。 一旦完成，在字符串的开头和结尾最多会有一个 VbLf。 最后两个 if 语句查找并删除后者。

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

Answer 4

在实施此解决方案之前，请在顶部设置两个变量的值。

FirstDataColumn = 1
FirstDataRow = 2

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

子 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

结束子