计算过滤结果并粘贴文本以计算数量

Question

目标：我想修改下面的代码，这样它就不会复制范围并将过滤后的范围粘贴到列中，而是计算过滤的行数，并使用计数，在下一个空行粘贴下 x 行的文本。

示例：我正在为所有非空白结果过滤收入损失列。结果是有 10 个条目符合此条件。然后，我想在另一张表（“计算数据”）中为 C 列中接下来的 10 个空行粘贴“收入或租金损失”。

代码：

Dim RPDataTbl As ListObject
Dim DescCol As ListColumn, BI As ListColumn
Dim copyRng As Range

Set RPDataTbl = Sheets("Risk Partner Data").ListObjects("RPdata")
With RPDataTbl
    Set DescCol = .ListColumns("Property Identifier")
    Set BIcol = .ListColumns("Loss of Income or Rent")

    .Range.AutoFilter Field:=BIcol.Index, Criteria1:="<>"
End With

On Error Resume Next
Set copyRng = DescCol.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not copyRng Is Nothing Then
    copyRng.Copy

    With Sheets("Calc Data")
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Value = "Loss of Income or Rent"
    End With

    Application.CutCopyMode = False
End If

RPDataTbl.Range.AutoFilter Field:=BIcol.Index

试图编辑代码，但它只粘贴一次特殊文本，而不是整个范围结果，例如如果 C 中有 10、10 行有“收入或租金损失”。

Answer 1

1. 将Option Explicit 添加到模块顶部。更好的是，转到工具 > 选项并单击需要变量声明。你有一个未声明的变量BIcol - 你声明了BI As ListColumn。
2. 关于您的主要问题，也许在Resize 中使用copyRng 的Count。请注意，修改了以下代码以匹配您的示例：过滤“收入损失”列，获取非空白结果的数量，然后将“收入损失或租金损失”粘贴到 C 列中。

---

Sub Test
    Dim RPDataTbl As ListObject
    Dim DescCol As ListColumn, BIcol As ListColumn
    Dim copyRng As Range

    Set RPDataTbl = Sheets("Risk Partner Data").ListObjects("RPdata")
    With RPDataTbl
        Set DescCol = .ListColumns("Property Identifier")
        Set BIcol = .ListColumns("Loss of Income or Rent")

        .Range.AutoFilter Field:=BIcol.Index, Criteria1:="<>"
    End With

    On Error Resume Next
    Set copyRng = BIcol.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not copyRng Is Nothing Then
        With Sheets("Calc Data")
            .Cells(.Rows.Count, "C").End(xlUp).Offset(1).Resize(copyRng.Count).Value = "Loss of Income or Rent"
        End With
    End If

    RPDataTbl.Range.AutoFilter Field:=BIcol.Index
End Sub