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

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

计算已过滤的结果并粘贴文本以获取数量

1 个答案: