需要从Excel表格中删除空行，然后使用VBA调整表格大小

我编写了一个宏（主要是通过记录），它从一张工作表的某个部分复制数据，然后计算另一张工作表的表尾，并将数据粘贴到表尾（粘贴特殊，因为我粘贴的数据是一个公式，我需要粘贴值），这本身就增加了表的大小。 这很有效

我的问题是，我不确定我的原始数据范围（我正在复制）中有多少实际包含值（有一个公式给它一个值或“”），所以我选择了一个较大的范围，以防万一

所以。。。。粘贴后，我希望遍历我的表，删除所有添加的只有空字符串（“”）且没有值的行，然后调整表的大小，使其与包含数据的行一样大。 这些行可以在粘贴数据的中间或结尾。 我需要有关VBA代码的帮助才能做到这一点

我可能还需要清除表格自动添加到这些附加行的格式 这是我到目前为止的代码

Range("O7:R30").Select    
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

---

如果数据有效，最好只将其放入表中，而不是在粘贴后进行清理

像这样的

Sub Demo()
    Dim rDest As Range
    Dim lo As ListObject
    Dim wsSrc As Worksheet
    Dim rSrc As Variant
    Dim i As Long
    Dim rng As Range

    'there are better ways to get a reference to the source data, but thats not the Q here
    Set wsSrc = ActiveSheet
    Set rSrc = wsSrc.Range("O7:R30")

    ' destination sheet
    With Sheets("deposits")
        'get reference to table
        Set lo = .ListObjects("deposits")

        'Get reference to first row after the table
        Set rDest = lo.DataBodyRange.Rows(lo.DataBodyRange.Rows.Count + 1)

        i = 0
        'loop thru source data rows
        For Each rng In rSrc.Rows
            'if a row has data
            If Application.WorksheetFunction.CountA(rng) > 0 Then
                'copy values into table
                rDest.Offset(i).Value = rng.Value
                i = i + 1
            End If
        Next
    End With
End Sub

---

如果数据有效，最好只将其放入表中，而不是在粘贴后进行清理

像这样的

Sub Demo()
    Dim rDest As Range
    Dim lo As ListObject
    Dim wsSrc As Worksheet
    Dim rSrc As Variant
    Dim i As Long
    Dim rng As Range

    'there are better ways to get a reference to the source data, but thats not the Q here
    Set wsSrc = ActiveSheet
    Set rSrc = wsSrc.Range("O7:R30")

    ' destination sheet
    With Sheets("deposits")
        'get reference to table
        Set lo = .ListObjects("deposits")

        'Get reference to first row after the table
        Set rDest = lo.DataBodyRange.Rows(lo.DataBodyRange.Rows.Count + 1)

        i = 0
        'loop thru source data rows
        For Each rng In rSrc.Rows
            'if a row has data
            If Application.WorksheetFunction.CountA(rng) > 0 Then
                'copy values into table
                rDest.Offset(i).Value = rng.Value
                i = i + 1
            End If
        Next
    End With
End Sub

---

这段代码起作用了，不优雅，但它起作用了

Sub copyToDeposits()

Dim theSheet As String
theSheet = ActiveSheet.Name
Application.ScreenUpdating = False
Range("O7:R30").Select
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Dim lo As ListObject
Dim lRow As ListRow
Dim rng As Range
Dim delRows As Collection

Set lo = ActiveSheet.ListObjects("deposits") 'change to your table name
On Error Resume Next
For Each lRow In lo.ListRows
    Set rng = Nothing
    Set rng = lRow.Range.Cells(1, 2)
    If Not rng Is Nothing Then
        If rng = "" Then
            If delRows Is Nothing Then
                Set delRows = New Collection
                delRows.Add lRow
            Else
                delRows.Add lRow, Before:=1
            End If
        End If
    End If
Next
On Error GoTo 0

If Not delRows Is Nothing Then
    For Each lRow In delRows
        lRow.Delete
    Next
End If
Sheets(theSheet).Select
Application.ScreenUpdating = True

---

End Sub

这段代码工作正常，不优雅，但它工作正常

Sub copyToDeposits()

Dim theSheet As String
theSheet = ActiveSheet.Name
Application.ScreenUpdating = False
Range("O7:R30").Select
Selection.Copy
Sheets("deposits").Select
Dim lastRow As Long
lastRow = ActiveSheet.ListObjects("deposits").Range.Rows.Count
Range("A" & lastRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Dim lo As ListObject
Dim lRow As ListRow
Dim rng As Range
Dim delRows As Collection

Set lo = ActiveSheet.ListObjects("deposits") 'change to your table name
On Error Resume Next
For Each lRow In lo.ListRows
    Set rng = Nothing
    Set rng = lRow.Range.Cells(1, 2)
    If Not rng Is Nothing Then
        If rng = "" Then
            If delRows Is Nothing Then
                Set delRows = New Collection
                delRows.Add lRow
            Else
                delRows.Add lRow, Before:=1
            End If
        End If
    End If
Next
On Error GoTo 0

If Not delRows Is Nothing Then
    For Each lRow In delRows
        lRow.Delete
    Next
End If
Sheets(theSheet).Select
Application.ScreenUpdating = True

---

End Sub

我尝试了范围（“存款[金额]”）.SpecialCells（xlCellTypeBlanks）.EntireRow.Delete，它抛出了一个错误，没有找到数据。似乎即使行显示为空白，它们也不会触发xlCellTypeBlanks。另外，当我选择表格（ctl-a）然后使用F5使用特殊->空白时，它不起作用。它也没有返回任何数据。即使单元格是空白的，只有空字符串（“”），但是公式返回空字符串的单元格不是空的。是的，我明白了。当单元格中的“某物”是（“”）时，有没有办法确定它是否存在？或者有没有更好的方法告诉IF公式让单元格真正为空您可以使用

COUNTA

函数返回非空单元格的数量，甚至返回空字符串的单元格，如

=“”

I trued Range（“存款[金额]”）。特殊单元格（xlCellTypeBlanks）.EntireRow.Delete并引发错误，但未找到任何数据。似乎即使行显示为空白，它们也不会触发xlCellTypeBlanks。另外，当我选择表格（ctl-a）然后使用F5使用特殊->空白时，它不起作用。它也没有返回任何数据。即使单元格是空白的，只有空字符串（“”），但是公式返回空字符串的单元格不是空的。是的，我明白了。当单元格中的“某物”是（“”）时，有没有办法确定它是否存在？或者有没有更好的方法告诉IF公式让单元格真正为空您可以使用

COUNTA

函数返回非空单元格的数量，即使是返回空字符串的单元格，如

=”

，它也不起作用。A.它没有将它添加到表中，它只是添加到表下的底部，但没有获得表格式，等等。在表b之后添加新行通常会得到的结果。它没有删除带有数据的行之间的空行。我猜CountA返回的值可能大于0，因为行（甚至是“空白”行）中有一个复制的公式，它不起作用。A.它没有将它添加到表中，它只是添加到表下的底部，但没有获得表格式，等等。在表b之后添加新行通常会得到的结果。它没有删除带有数据的行之间的空行。我猜CountA返回的值可能大于0，因为行（甚至是“空白”行）中存在复制的公式