.SpecialCells(xlCellTypeVisible).Rows.Count不会返回正确的可见行数

时间:2019-04-16 02:28:53

标签: excel vba

我正在使用此代码过滤所需的数据,以便可以将其复制并粘贴到其他工作簿中。

过滤器没有问题,但是Count返回错误的可见行数。

Count1 = .SpecialCells(xlCellTypeVisible).Rows.Count

我也尝试过 Count1 = Rows.SpecialCells(xlCellTypeVisible).Count,但它给我错误。

Sub ListForeignTrans()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Rng As Range
Dim CoName As Range
Dim Count1 As Long


Set wsDest = ThisWorkbook.Worksheets("List Foreign Trans")

Set Rng = wsDest.Range("E2")   'To be use in the directory

Set CoName = wsDest.Range("E1") 'To be use in the directory

'Open workbook
Workbooks.Open Filename:= _
  "\\172.17.10.134\Finance Tower\0042_Witholding Tax\" & CoName & "\" & Rng & "\" & CoName & " Exp GL " & Rng & ".XLSX"

'Filter

With Workbooks(CoName & " Exp GL " & Rng & ".XLSX").Worksheets("Sheet1").Range("A1")
.AutoFilter Field:=19, Criteria1:="<>MYR" _
    , Criteria2:="<>", Operator:=xlAnd
.AutoFilter Field:=20, Criteria1:="<>0.00"
.AutoFilter Field:=2, Criteria1:="<> "
Count1 = .SpecialCells(xlCellTypeVisible).Rows.Count 'Count Row

'If only 1 row close workbook, else proceed to copy from the workbook open by previous step to current workbook.
If Count1 = 1 Then GoTo Line1 Else
  Set wsCopy = Workbooks(CoName & " Exp GL " & Rng & ".XLSX").Worksheets("Sheet1")
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "Q").End(xlUp).Offset(1).Row
    wsCopy.Range("B2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy _
    wsDest.Range("Q" & lDestLastRow)
End With

Line1:
'Close Workbook
Workbooks(CoName & " Exp GL " & Rng & ".XLSX").Close SaveChanges:=False

End Sub

应该有3行。但是结果一直给我1行。

1 个答案:

答案 0 :(得分:0)

我找到了解决方案,并在其中添加了以下行:

Set Rng1 = ActiveSheet.AutoFilter.Range
Count1 = Rng1.Columns(2). _
   SpecialCells(xlCellTypeVisible).Count

下面是完整代码:

Sub ListForeignTrans()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Rng As Range
Dim Rng1 As Range
Dim CoName As Range
Dim Count1 As Long


Set wsDest = ThisWorkbook.Worksheets("List Foreign Trans")

Set Rng = wsDest.Range("E2")   'To be use in the directory

Set CoName = wsDest.Range("E1") 'To be use in the directory

' List of Foreign Trans

'Open workbook
Workbooks.Open Filename:= _
"\\172.17.10.134\Finance Tower\0042_Witholding Tax\" & CoName & "\" & Rng & "\" & CoName & " Exp GL " & Rng & ".XLSX"

'Filter

With Workbooks(CoName & " Exp GL " & Rng & ".XLSX").Worksheets("Sheet1").Range("A1")
.AutoFilter Field:=19, Criteria1:="<>MYR" _
    , Criteria2:="<>", Operator:=xlAnd
.AutoFilter Field:=20, Criteria1:="<>0.00"
.AutoFilter Field:=2, Criteria1:="<> "
Set Rng1 = ActiveSheet.AutoFilter.Range
Count1 = Rng1.Columns(2). _
   SpecialCells(xlCellTypeVisible).Count


'If only 1 row close workbook, else proceed to copy from the workbook open by previous step to current workbook.
If Count1 = 1 Then GoTo Line1 Else
  Set wsCopy = Workbooks(CoName & " Exp GL " & Rng & ".XLSX").Worksheets("Sheet1")
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "Q").End(xlUp).Offset(1).Row
    wsCopy.Range("B2").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy _
    wsDest.Range("Q" & lDestLastRow)
End With

Line1:
'Close Workbook
Workbooks(CoName & " Exp GL " & Rng & ".XLSX").Close SaveChanges:=False

End Sub
相关问题