在Excel VBA中,从具有SpecialCells(xlCellTypeVisible)的表创建的范围将获得筛选的额



我有一个包含多个数据的表的工作表。我需要将筛选后的数据复制到word文档中。首先,我尝试过excel中的.copy和word中的.pastespecial,但在过去的4天里读了很多之后,我开始直接处理对象,因为复制/粘贴过程很慢,而且没有得到我想要的结果。

使用Object方法,我发现当specialCells(xCellTypeVisible(的范围有多个区域时,您需要查看每个区域以获得行数。但由于某些原因,在"范围"中添加了一行,但该行未显示在"过滤器"中。

代码在表"Called"中进行过滤;Horas";在一张称为";Horas";由A列中的字符串和D列中的数组(D列可能具有以下值V、W、X、Y和Z(

当按列A筛选,然后按数组(X、Y和Z(筛选时,用列A筛选的某些行(其值不是X、Y、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

此代码按客户正确筛选,但当客户的某些行的值不是X、Y和Z时,仍会出现在范围内并复制到Word表中。

我想我对这个线程也有同样的问题,但在这个线程中,数据以连续的行出现在同一区域。在我的例子中,应用D列过滤器时会过滤几行。

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

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

最新更新