使用 SpecialCells(xlCellTypeVisible) in Excel VBA 中的表创建的范围获取额外的行，这些行已被过滤

Question

我有一个包含多个数据的表格的工作表。 我需要将过滤后的数据复制到 word 文档中。 首先，我尝试使用 excel 中的 .copy 和 word 中的 .pastespecial，但在过去 4 天阅读了大量内容后，我开始直接使用对象，因为复制/粘贴过程很慢，而且没有得到我想要的结果想。

使用 Object 方法，我发现当带有 specialCells(xCellTypeVisible) 的范围有多个区域时，您需要查看每个区域以获取行数。 但是由于某种原因，在 Range 中添加了一行，但该行未显示在 Filter 中。

代码通过 A 列中的字符串和 D 列中的数组（D 列可以具有以下值 V、W、X、Y 和 Z）在名为“Horas”的工作表中过滤名为“Horas”的表

当按 A 列过滤然后按数组（X、Y 和 Z）过滤时，使用 A 列过滤且 XY 和 Z 以外的值的某些行在范围内且未被过滤。

这是代码的一部分

'code to set word app, word doc and set XLSDoc objects, etc
    Set xlsSheet = xlsDoc.Worksheets("Horas")
    xlsSheet.Activate
    
    ' Clear AutoFilter
    For nCounter = 1 To xlsSheet.ListObjects("Horas").ListColumns.Count
        xlsSheet.ListObjects("Horas").Range.AutoFilter Field:=nCounter
    Next
    
    ' Filter by customer and Row Type 
    xlsSheet.ListObjects("Horas").Range.AutoFilter Field:=1, Criteria1:=customer
    xlsSheet.ListObjects("Horas").Range.AutoFilter Field:=4, Criteria1:=Array("X", "Y", "Z"), Operator:=xlFilterValues
    
    ' calculate las row in table            
    Dim LR As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row - 1
    Dim rngFiltered As Range
    Set rngFiltered = Nothing
                   
    On Error Resume Next
    'define range with cells visible in table
    Set rngFiltered = Range("B2:G" & LR).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' check if range return values
    If Not rngFiltered Is Nothing Then
        Dim lcount
        Dim rngArea
    'check every area in range to get row count
        For Each rngArea In rngFiltered.SpecialCells(xlCellTypeVisible).Areas 
             lcount = lcount + rngArea.Rows.Count
        Next
        Dim i As Long
    'Add a row in word Table for every row in range filtered with visible cells
        For i = 1 To lcount
            HourTable.Rows.Add
            Set oRow = HourTable.Rows(HourTable.Rows.Count)
            Dim z As Long
            For z = 1 To 6
    'Copy every cell to word document
                 oRow.Cells(z).Range.Text = rngFiltered.Cells(i, z))
    Else
    'code to add a row if range is empty
        HourTable.Rows.Add
        Set oRow = HourTable.Rows(HourTable.Rows.Count)
        Dim mergeRNG As Word.Range
        Set mergeRNG = oRow.Cells(1).Range
        mergeRNG.End = oRow.Cells(HourTable.Columns.Count).Range.End
        mergeRNG.Cells.Merge
        HourTable.Cell(HourTable.Rows.Count, 1).Range.Text = "No se registraron horas en el período"
    End If

此代码按客户正确过滤，但当客户有一些行的 XY 和 Z 以外的值仍然出现在范围内并被复制到 Word 表时。

我想我和这个线程有同样的问题，但在这个线程中，数据出现在同一区域的连续行中。 在我的例子中，当应用 Column D 过滤器时，多行被过滤。

提前感谢您的阅读。 请原谅我的英文写作。

Answer 1

oRow.Cells(z).Range.Text = rngFiltered.Cells(i, z)

您不能使用这样的索引访问多区域（非连续）范围。

为了显示：

Sub Tester()

    Dim rngVis As Range, rw As Range, i As Long
    
    'rows 2:3 and 5 are hidden
    Set rngVis = ActiveSheet.Range("A1:C6").SpecialCells(xlCellTypeVisible)
    
    Debug.Print rngVis.Address(False, False)             '>> A1:C1,A4:C4,A6:C6
    
    Debug.Print rngVis.Cells(1, 1).Address(False, False) '>> A1
    Debug.Print rngVis.Cells(2, 1).Address(False, False) '>> A2 ! Cannot access range this way
    
    'loop rows like this, not using a counter.
    For Each rw In rngVis.Rows
        i = i + 1
        Debug.Print i, rw.Address(False, False)
    Next rw
    'Output:
    '1            A1:C1
    '2            A4:C4
    '3            A6:C6

End Sub