VBA隐藏指定条件的行

首页 > Excel VBA 作者：皮皮华 2021年1月26日 17:03 星期二热度：1540° 字号：小中大评论：0 条

时间：2021-1-26 17:03 热度：1540° 评论：0 条

某天一个朋友找到我，想让我帮他处理一下Excel表格，如下图所示一共5991行，要求是每一列的值都相等就隐藏，如果某一行存在NULL或者不想等的值则显示当前行。

其实实现方法不难，主要是学会调用Cells函数获取指定坐标的单元格内容并对其判断和处理。代码如下

'列号转字母（列名）
Function Num2Name(ByVal ColumnNum As Long) As String
    On Error Resume Next
    Num2Name = "" '超出范围返回空，如调用Num2Name(100000)
    Num2Name = Replace(Cells(1, ColumnNum).Address(0, 0), "1", "")
    'Cell.Address用来返回单元格的地址，参数(0,0)返回相对地址A1，参数(1,1)返回绝对地址$A$1
End Function
'字母（列名）转列号
Function Name2Num(ByVal ColumnName As String) As Long
    On Error Resume Next
    Name2Num = -1 '超出范围返回0,如调用Name2Num("AAAA") ,EXCEL没有那么多列
    Name2Num = Range("A1:" & ColumnName & "1").Cells.Count
End Function
'展示所有行
Function ShowAllROW()
    Dim ALLRow As Long
    ALLRow = 5991 '最后一行行数
    For i = 1 To ALLRow
        ActiveSheet.Rows(i).Hidden = False
    Next
End Function
'主函数
Sub PPH()
    Dim ALLRow As Long, ALLLine As Long
    Dim NowRow As Long, NowLine As Long
    Dim HideFlag As Boolean
    ALLRow = 5991 '最后一行行数
    ALLLine = Name2Num("AA")  '最后一列列名

    For NowRow = 2 To ALLRow
        HideFlag = True
        For NowLine = 2 To ALLLine
            If Cells(NowRow, NowLine) = "NULL" Then '包含NULL则不隐藏
                HideFlag = False
                Exit For
            End If
            If NowLine = 2 Then '跳过列为2

            Else
                If Cells(NowRow, NowLine - 1) <> Cells(NowRow, NowLine) Then '与前一列值不等则不隐藏
                    HideFlag = False
                    Exit For
                End If
            End If
        Next
        If HideFlag Then '隐藏当前行
            ActiveSheet.Rows(NowRow).Hidden = True
        End If
    Next

End Sub

最终效果如下图所示

统计数据

    Sub PPH()
        Dim ALLRow As Long, ALLLine As Long
        Dim NowRow As Long, NowLine As Long
        Dim TotalNum As Long '总表数
        Dim Flag As Boolean
        ALLRow = 48536 '最后一行行数
        TotalNum = 0
        For NowRow = 2 To ALLRow Step 17
            Flag = False
            If Cells(NowRow, Name2Num("B")) = "有校表" Then
                For i = 0 To 16
                    NowLine = Name2Num("H")
                    If Cells(NowRow + i, NowLine) Like "[\[]202*" Then '正则匹配[202开头
                        Flag = True
                        Exit For
                    End If
                    NowLine = Name2Num("K")
                    If Cells(NowRow + i, NowLine) Like "[\[]202*" Then '正则匹配[202开头
                        Flag = True
                        Exit For
                    End If
                    NowLine = Name2Num("N")
                    If Cells(NowRow + i, NowLine) Like "[\[]202*" Then '正则匹配[202开头
                        Flag = True
                        Exit For
                    End If
                    NowLine = Name2Num("Q")
                    If Cells(NowRow + i, NowLine) Like "[\[]202*" Then '正则匹配[202开头
                        Flag = True
                        Exit For
                    End If
                Next
                If Flag = True Then
                    TotalNum = TotalNum + 1
                    For i = 0 To 16
                        ActiveSheet.Rows(NowRow + i).Interior.Color = vbYellow '标记当前表的背景色
                    Next
                End If
            End If
        Next
        Cells(1, Name2Num("R")) = "总表数" & TotalNum '输出统计结果
    End Sub

计时动作与单元格点击事件

'Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long'调用延时函数
Private Declare Function timeGetTime Lib "winmm.dll" () As Long '调用延时函数
'字母（列名）转列号
Function Name2Num(ByVal ColumnName As String) As Long
    On Error Resume Next
    Name2Num = -1 '超出范围返回0,如调用Name2Num("AAAA") ,EXCEL没有那么多列
    Name2Num = Range("A1:" & ColumnName & "1").Cells.Count
End Function
'自定义延时函数
Sub Delay(T As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
        DoEvents
    Loop While timeGetTime - time1 < T
End Sub
'点击清除按钮
Private Sub CleanColor_Click()
    ActiveSheet.Rows(3).Interior.ColorIndex = 0  '删除背景色
End Sub
'点击计时按钮
Private Sub TimeCount_Click()
    Dim DelayTime As Long
    Dim StartRow As Long, EndRow As Long
    Dim NowRow As Long, NowLine As Long
    Dim NowTimeRow As Long, NowTimeLine As Long
    
    '*******参数设置**************
    DelayTime = 1000         '设置延时时间 单位为毫秒 如500为0.5秒 1000为1秒
    NowRow = 3          '设置变化的起始行数
    StartRow = Name2Num("B") '设置变化的起始列 例如 B
    EndRow = Name2Num("T")  '设置变化的结束列 例如 Q
    NowTimeLine = Name2Num("B") '设置系统时间位置列数
    NowTimeRow = 1          '设置系统时间位置行数
    '**********************
    Cells(NowTimeRow, NowTimeLine) = Format(Now(), "yyyy年mm月dd日 hh:mm:ss:") & Format((Timer - Int(Timer)) * 1000, "000")
    For i = StartRow To EndRow
        NowLine = i
        Delay DelayTime
        ActiveSheet.Cells(NowRow, NowLine).Interior.Color = vbRed '标记当前表的背景色为红色
        Cells(NowTimeRow, NowTimeLine) = Format(Now(), "yyyy年mm月dd日 hh:mm:ss:") & Format((Timer - Int(Timer)) * 1000, "000")
    Next
End Sub
'单元格点击事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect([B4:T10], Target) Is Nothing Then '仅在B4：T10范围内点击起作用
        If Target.Value = "" Then '如果单元格为空
            Target.Value = "▲"
        Else
            Target.Value = ""
        End If
    End If
End Sub