excel 选择范围并按前缀过滤,然后隐藏(设置范围的问题)

iecba09b  于 2023-05-08  发布在  其他
关注(0)|答案(1)|浏览(86)
Sub Group()

     Dim arrList As Variant
     Dim rng As Excel.Range
     Dim rCell As Range
     Dim N As Long

Set rng = Range(ActiveCell, ActiveCell.End(xlDown)).Select
 
 arrList = Array("TP001P*")

For Each rCell In rng.Cells
For N = LBound(arrList) To UBound(arrList)

       If VBA.InStr(1, rCell.Value, arrList(N), vbTextCompare) > 0 Then
       rCell.EntireRow.Hidden = True
       Exit For
       End If
       Next 'N
       Next 'rCell
 
End Sub
lmvvr0a8

lmvvr0a81#

使用Like函数过滤“by prefix”。然后通过将所有的发现添加到一个范围中,将所有的行隐藏在一起

Option Explicit

Sub Group()
   Dim arrList As Variant, rng As Range, rCell As Range, N As Long
   Dim lb As Long, ub As Long, toHide As Range
   Set rng = Range(ActiveCell, ActiveCell.End(xlDown))
   arrList = Array("TP001P*")
   lb = LBound(arrList)
   ub = UBound(arrList)
   
   For Each rCell In rng.Cells
      For N = lb To ub
         If rCell.Value Like arrList(N) Then
            If toHide Is Nothing Then
               Set toHide = rCell
            Else
               Set toHide = Union(toHide, rCell)
            End If
            Exit For
         End If
      Next
   Next
   If Not toHide Is Nothing Then toHide.EntireRow.Hidden = True
End Sub

如果需要相反的结果,请设置一个“不”,如下所示:

If Not (rCell.Value Like arrList(N)) Then

由于我似乎不明白你需要什么,我将用一个更通用的解决方案来补充我的答案,以隐藏-显示行或列,根据需要用OR连接尽可能多的条件。x1c 0d1x将此代码放入模块(不是表单模块):

Option Explicit

Public Enum ShowOrHide
   HideIt = True
   ShowIt = False
End Enum

'-----------------------------------------------------------------------------
'rngToScan: a rarge with one column OR one Row. If have one colum: hide-unhide rows, if have one row: hide-unhide columns
'withFoundsToDo: Choose what to do with the rows or columns that meet the criteria (Values: HideIt , ShowIt)
'caseSensitive: Set True for Case-sensitive comparison, otherwise set False
'arrCriteria(): Array with as many criteria as you need
'Usage examples:
'Call hide_Or_Show(Me.Range("A_NAMED_RANGE"),ShowIt,False,"OK*","GOOD*")
'Call hide_Or_Show(Me.Range("A10:A100"),ShowIt,False,"T4*","T5*","T6*","T*456")
'Call hide_Or_Show(Me.Range("A10:A100"),HideIt,False,"temp*","tmp*")
'Call hide_Or_Show(Me.Range("A10:A100"),HideIt,False,Range("A2").Value,Range("A3").Value,Range("A4").Value)
'------------------------------------------------------------------------------
Public Sub hide_Or_Show(rngToScan As Range, withFoundsToDo As ShowOrHide, caseSensitive As Boolean, ParamArray arrCriteria() As Variant)
   Dim rCell As Range, found As Range, notFound As Range, entireFound As Range, entireNotFound As Range
   Dim cc As Long, rr As Long, ub As Long, fbool As Boolean, nfbool As Boolean, critExist As Boolean, rslt As Boolean

   rr = rngToScan.Rows.CountLarge
   If (rr <> 1 And rngToScan.Columns.CountLarge <> 1) Then
      MsgBox ("Function hideOrShow> rngToScan must have one Row or one Column")
      Exit Sub
   End If
   ub = UBound(arrCriteria)
   For cc = 0 To ub
      If arrCriteria(cc) <> vbNullString Then
         critExist = True
         Exit For
      End If
   Next
   If Not critExist Then
      Set found = rngToScan
   Else
      For Each rCell In rngToScan.Cells
         For cc = 0 To ub
            If arrCriteria(cc) <> vbNullString Then
               If caseSensitive Then rslt = rCell.Value Like arrCriteria(cc) Else rslt = UCase(rCell.Value) Like UCase(arrCriteria(cc))
               If rslt Then
                  If found Is Nothing Then
                     Set found = rCell
                  Else
                     Set found = Union(found, rCell)
                  End If
                  GoTo LnextCell
               End If
            End If
         Next
         If notFound Is Nothing Then
            Set notFound = rCell
         Else
            Set notFound = Union(notFound, rCell)
         End If
LnextCell:
      Next
   End If
   fbool = Not found Is Nothing
   nfbool = Not notFound Is Nothing
   
   If rr = 1 Then 'show-hide columns
      If fbool Then Set entireFound = found.EntireColumn
      If nfbool Then Set entireNotFound = notFound.EntireColumn
   Else            'show-hide rows
      If fbool Then Set entireFound = found.EntireRow
      If nfbool Then Set entireNotFound = notFound.EntireRow
   End If

   If withFoundsToDo = HideIt Then     ' hide anything found, show anything not found  - in rngToScan
      If nfbool Then entireNotFound.Hidden = ShowIt
      If fbool Then entireFound.Hidden = HideIt
   Else                                'hide anything not found, show anything found  - in rngToScan
      If fbool Then entireFound.Hidden = ShowIt
      If nfbool Then entireNotFound.Hidden = HideIt
   End If
End Sub

在Sheet模块中调用hide_Or_Show。在我的示例中,我通过Worksheet_Change调用它,在那里我检查两个条件中的任何一个是否发生了变化,如果确实发生了变化,我就调用它。

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("B12:B13")) Is Nothing Then
      Call hide_Or_Show(Me.Range("B3:B9"), ShowIt, False, Range("B12").Value, Range("B13").Value)
   End If
End Sub

相关问题