我有此功能,该功能接受一个工作表名称并使激活的工作表名称生效。但是由于某种原因,它并不能使“ Actives”工作表发挥作用。
完整代码:
Public wb As Workbook
Public ws As String
Public filterValue() As String
Public My_Range As Range
Public i As Integer
Public CCount As Long
Sub test()
'Dim My_Range As Range
Dim CalcMode As Long
Dim ViewMode As Long
Dim FilterCriteria As String
'Dim CCount As Long
Dim WSNew As Worksheet
Dim Sheetname As String
'Dim i As Integer
Dim j As Integer
Dim k As Long
Dim rng As Range
'Set wb = ThisWorkbook
Sheets("Input Sheet").Select
NumRows = Sheets("Input Sheet").UsedRange.Rows.Count
ReDim filterValue(1 To NumRows)
For j = 1 To NumRows
If Not IsEmpty(Cells(j, 1).Value) Then
filterValue(j) = Cells(j, 1).Value
End If
Next j
DeleteNonMatched ("Actives")
'For k = LBound(filterValue) + 1 To UBound(filterValue)
'End If
'Next k
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function DeleteNonMatched(ByVal Sheetname As Worksheet)
Dim ws As Worksheet
On Error Resume Next
Sheets(Sheetname).Select
Set ws = wb.Sheets("Actives")
ws.Activate
Set My_Range = Range("A1:F" & LastRow(ws))
My_Range.Parent.Select
My_Range.Parent.AutoFilterMode = False
My_Range.AutoFilter Field:=5, Criteria1:="<>#N/A"
CCount = 0
On Error Resume Next
CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count - 1
For i = 1 To CCount
My_Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
i = i + 1
On Error GoTo 0
'If CCount <> 0 Then
'MsgBox CCount
Next i
On Error GoTo 0
End Function
----Function not working-----------
Function DeleteNonMatched(ByVal Sheetname As Worksheet)
Dim ws As Worksheet
On Error Resume Next
Sheets(Sheetname).Select
Set ws = wb.Sheets("Actives")
ws.Activate
Set My_Range = Range("A1:F" & LastRow(ws))
My_Range.Parent.Select
My_Range.Parent.AutoFilterMode = False
My_Range.AutoFilter Field:=5, Criteria1:="<>#N/A"
CCount = 0
On Error Resume Next
CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count - 1
For i = 1 To CCount
My_Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
i = i + 1
On Error GoTo 0
'If CCount <> 0 Then
'MsgBox CCount
Next i
On Error GoTo 0
End Function