我正在使用此代码过滤所需的数据,以便可以将其复制并粘贴到其他工作簿中。
过滤器没有问题,但是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行。
答案 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