Excel 计数筛选结果并粘贴计数金额的文本

目标：我想修改下面的代码，这样它就不会复制一个范围并将过滤后的范围粘贴到列中，而是计算过滤后的行数，并使用该计数将文本粘贴到下一个空行的下一个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

Dim RPDataTbl作为ListObject
Dim DescCol作为列表列，BI作为列表列
暗拷贝As范围
设置RPDataTbl=表格（“风险合作伙伴数据”）。列表对象（“RPdata”）
使用RPDataTbl
Set DescCol=.ListColumns（“属性标识符”）
Set BIcol=.ListColumns（“收入或租金损失”）
.Range.AutoFilter字段：=BIcol.Index，标准1:“”
以
出错时继续下一步
设置copyRng=DescCol.DataBodyRange.SpecialCells（xlCellTypeVisible）
错误转到0
如果不是copyRng，那就什么都不是了
复制，复制
带图纸（“计算数据”）
.Cells（.Rows.Count，“B”）.End（xlUp）.Offset（1）.Value=“收入或租金损失”
以
Application.CutCopyMode=False
如果结束
RPDataTbl.Range.AutoFilter字段：=BIcol.Index

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

将

选项Explicit

添加到模块顶部。更好的方法是，转到工具>选项并单击要求变量声明。您有一个未声明的变量

BIcol

-您将

BI声明为ListColumn

关于您的主要问题，可以在

调整大小

中使用

copyRng

的

计数

。请注意，下面的代码经过修改以匹配您的示例：过滤“收入损失”列，获取非空白结果的数量，并在C列中粘贴“收入损失或租金损失”

---

子测试
作为ListObject的Dim RPDataTbl
Dim DescCol作为列表列，BIcol作为列表列
暗拷贝As范围
设置RPDataTbl=表格（“风险合作伙伴数据”）。列表对象（“RPdata”）
使用RPDataTbl
Set DescCol=.ListColumns（“属性标识符”）
Set BIcol=.ListColumns（“收入或租金损失”）
.Range.AutoFilter字段：=BIcol.Index，标准1:“”
以
出错时继续下一步
设置copyRng=BIcol.DataBodyRange.SpecialCells（xlCellTypeVisible）
错误转到0
如果不是copyRng，那就什么都不是了
带图纸（“计算数据”）
.Cells（.Rows.Count，“C”）.End（xlUp）.Offset（1）.Resize（copyRng.Count）.Value=“收入或租金损失”
以
如果结束
RPDataTbl.Range.AutoFilter字段：=BIcol.Index
端接头

难以置信，非常感谢您的解释和生成的代码。工作得非常好。非常感谢！太好了，很高兴帮忙！

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