Question

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

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

对这样一个宏的任何建议？

非常感谢。

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：=＆＃34;＆＃34;，LookAt：= xlPart

Cells.Replace what：= Chr（10），Replacement：=＆＃34;＆＃34;，LookAt：= xlPart

Answer 3

这通常足以处理每个单元格中包含任何＃换行符的任何单元格列。它假设您的所有值都在列中，并且＃34; A＆＃34;从活动工作表的第1行开始：

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

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

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

End Sub

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

4 个答案: