Question

我有一张包含A到M列的表格，其中包含一个包含所有行和列的表格。如果在E列中，单元格包含字符串＆＃34; Drive＆＃34;，＆＃34; Inactivity＆＃34;或＆＃34; Halt＆＃34;然后我想要隐藏行。如果在E列中，一个单元格不包含字符串＆＃34; UF _＆＃34;，那么我希望它被隐藏。

我已经尝试过几件事并且已经在很多地方看过了。这是我尝试过的一些代码：

尝试1（花费很长时间）：

With ActiveSheet
loopct = 2

While loopct < count1
    DoEvents
    Application.StatusBar = "Making Table " & loopct
    txtrmv1 = "Drive"
    txtrmv2 = "Inactivity"
    txtrmv3 = "Halt"
    txtkp = "UF_"

    celltxt = .Range("E" & loopct).Value

    If InStr(1, celltxt, txtrmv1, vbTextCompare) Then
        .Range("E" & loopct).EntireRow.Hidden = True
    End If
    If InStr(1, celltxt, txtrmv2, vbTextCompare) Then
        .Range("E" & loopct).EntireRow.Hidden = True
    End If
    If InStr(1, celltxt, txtrmv3, vbTextCompare) Then
        .Range("E" & loopct).EntireRow.Hidden = True
    End If
    If InStr(1, celltxt, txtkp, vbTextCompare) Then
        .Range("E" & loopct).EntireRow.Hidden = False
    Else
        .Range("E" & loopct).EntireRow.Hidden = True
    End If

    loopct = loopct + 1
Wend

End With

尝试2（运行但没有完成任何事情）：

Private Sub HideDrive(ByVal count1 As Long)
    Dim ws As Worksheet
    Dim rng As Range, aCell As Range, bCell As Range

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    With ws
        Set rng = .Range("E2:E" & CStr(count1))

        Set aCell = rng.Find(What:="Drive", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=True, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell
            Do
                aCell.EntireRow.Hidden = True
                Set aCell = rng.FindNext(After:=aCell)

            Loop While aCell Is Nothing And aCell.Address <> bCell
        End If
    End With
End Sub

当我只有一个标准要检查时，我正在使用这些（显然我的引用已经改变）：

ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= "=*UF_*"

我能做些什么来完成我想要的？我还没有能够使用两个以上的标准来使用自动过滤器。请让我知道！

Answer 1

你可能会多次隐藏。这样更好：

If InStr(1, celltxt, txtrmv1, vbTextCompare) > 0 Or _
   InStr(1, celltxt, txtrmv2, vbTextCompare) > 0 Or _
   InStr(1, celltxt, txtrmv3, vbTextCompare) > 0 Or _
   InStr(1, celltxt, txtkp, vbTextCompare) = 0 Then
     .Range("E" & loopct).EntireRow.Hidden = True
End If

编辑：这应该是一个重要的加速 - 它一次隐藏10行：（还添加了Next iRow）

Option Explicit
Dim ws As Worksheet

Sub Sub1()
  Dim iRow&, Count1&, txtrmv1, txtrmv2$, txtrmv3$, txtkp$, celltxt$
  Set ws = ActiveWorkbook.Sheets("Sheet1")
  Count1 = 65000 ' ??
  txtrmv1 = "Drive"
  txtrmv2 = "Inactivity"
  txtrmv3 = "Halt"
  txtkp = "UF_"
  For iRow = 2 To Count1
    DoEvents
    Application.StatusBar = "Making Table " & iRow
    celltxt = ws.Range("E" & iRow).Value
    If InStr(1, celltxt, txtrmv1, vbTextCompare) > 0 Or _
       InStr(1, celltxt, txtrmv2, vbTextCompare) > 0 Or _
       InStr(1, celltxt, txtrmv3, vbTextCompare) > 0 Or _
       InStr(1, celltxt, txtkp, vbTextCompare) = 0 Then
         Call hideSub(iRow) '
    End If
  Next iRow ' thank you, tannmann357
  Call hideSub(0) ' flush
End Sub

Sub hideSub(hideRow&) ' hides 10 rows at a time
  Static a1&(10), na1&
  Dim i1&, zRange As Range
  If hideRow = 0 Then ' finish;end;flush
    For i1 = 1 To na1
      ws.Rows(a1(i1)).Hidden = True
    Next i1
    na1 = 0
  Else ' store row in array a1
    na1 = na1 + 1
    a1(na1) = hideRow
    If na1 = 10 Then ' hide 10 rows
      Set zRange = Union( _
        Rows(a1(1)), Rows(a1(2)), Rows(a1(3)), Rows(a1(4)), Rows(a1(5)), _
        Rows(a1(6)), Rows(a1(7)), Rows(a1(8)), Rows(a1(9)), Rows(a1(10)))
'Debug.Print zRange.Address
      ' this works but the syntax seems strange -- help me out
      ws.Range(zRange.Address).Rows.Hidden = True
      na1 = 0
    End If
  End If
End Sub

编辑：为了我的利益：

替换

  ' this works but the syntax seems strange -- help me out
  ws.Range(zRange.Address).Rows.Hidden = True

带

  ws.Range(zRange).Rows.Hidden = True

Answer 2

我无法调试并运行给出的其他答案，所以我继续工作并自己解决了。

我没有试图隐藏我不想要的所有单词，而是单独隐藏它们，然后每次都调用隐藏行删除功能。

        ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _
            tblnm

        'insert if statement here to change filters based upon area
        ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="=*UF_*"

        Call RhidRow2(count4)

        ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="<>*Drive*"

        Call RhidRow2(count4)

        ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="<>*Inactivity*"

        Call RhidRow2(count4)

        ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:="<>*Halt*"

        Call RhidRow2(count4)

        ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:="<>#VALUE!"

        Call RhidRow2(count4)

这是隐藏的行删除器：

Private Sub RhidRow2(ByVal count4 As Long)
    Dim count1 As Long 'counters to be used
    Dim ws As Worksheet
    Dim rngVis As Range
    Dim rngDel As Range
    Set ws = ActiveSheet

    On Error Resume Next
    Set rngVis = ws.Range("A2:A" & count4).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rngVis Is Nothing Then
        ws.Range("Z1").Value = 1
    Else

        For count1 = count4 To 2 Step -1
            If ws.Rows(count1).Hidden = True Then
                If rngDel Is Nothing Then
                    Set rngDel = ws.Rows(count1)
                Else
                    Set rngDel = Union(rngDel, ws.Rows(count1))
                End If
            End If
        Next count1

    If Not rngDel Is Nothing Then
        Application.DisplayAlerts = False
        Intersect(rngDel, rngDel.ListObject.DataBodyRange).Delete 'if row is hidden, delete
        Application.DisplayAlerts = True
    End If

    End If
End Sub

这比我尝试或建议过的任何其他方法都更好，更快。

如果列中的单元格包含某些文本或使用4个条件自动过滤单个字段，则隐藏行

2 个答案: