函数DeleteNonMatched(ByVal工作表名称为工作表)不能按预期工作

时间:2018-11-30 01:49:51

标签: excel vba excel-vba

我有此功能,该功能接受一个工作表名称并使激活的工作表名称生效。但是由于某种原因,它并不能使“ 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

0 个答案:

没有答案