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

以下是我试图通过包含字符串的工作表中的所有单元格实现的目标，但迄今为止成功率有限：

|示例|
单元格1\u空\u行
单元格1\u文本1
单元格1\u空\u行
+---------------------+
单元格2\u文本1
细胞2_空蛋白
单元格2\u文本2
+---------------------+
cell3_emptyline
cell3_emptyline
单元格3\u text1
+---------------------+

|预期结果|
单元格1\u文本1
+---------------------+
单元格2\u文本1
单元格2\u文本2
+---------------------+
单元格3\u text1
+---------------------+

有没有关于这样一个宏观调控的建议

---

非常感谢

如果您只使用一个单元格及其内的空行，则其中一个单元格应可用：

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

---

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

这足够通用，可以处理每个单元格中具有任何行馈送的任何单元格列。它假定所有值都在从活动工作表第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语句查找并删除后者

---

末端的自动调整是可选的，只是为了美化结果；它只是将单元格压缩到其最小高度。

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

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

---

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

FirstDataColumn = 1
FirstDataRow = 2

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

子删除空白（）

端接头

---

数据选项卡：过滤器。取消选择全部。选择空白突出显示空白行，然后按删除按钮。卸下滤清器。

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