☰

根据该行单元格上显示的基于公式的结果隐藏/取消隐藏行

tag-icon • tag-icon microsoft-excel
根据该行单元格上显示的基于公式的结果隐藏/取消隐藏行

我正在努力寻找一个 VBA 代码来处理这种情况：Q23 到 Q73 是带有公式的单元格，因此我无法手动对它们进行任何输入。

第 24 行到第 73 行通常是隐藏的，但如果 Q24 行到 Q73 显示任何结果，我需要它们自动取消隐藏，如果它们为空（显示的公式结果为“”），则返回到隐藏状态。

答案1

这是我正在使用的使用录制宏制作的 ClearApp 宏：

Sub ClearApp()
ClearApp Macro
Range( _
"B5:B7,E4:E7,C1,C2,F5,F7,A13:G13,A14:G21,A23:G82,H24:I82,J12:M82,N12:O82,N10:O10,J10:M10,V    7,V9,P73:AB82,W12:W82,A104:N779,C88:G88" _
    ).Select
Range("W12").Activate
ActiveWindow.SmallScroll Down:=12
Range( _
"B5:B7,E4:E7,C1,C2,F5,F7,A13:G13,A14:G21,A23:G82,H24:I82,J12:M82,N12:O82,N10:O10,J10:M10,V7,V9,P73:AB82,W12:W82,A104:N779,C88:G88" _
    ).Select
Range("A49").Activate
Sheets("test").Select
 Selection.ClearContents
End sub

答案2

这应该适用于工作表代码（将 sheet1 更改为正确的工作表），而不是在模块中。

Option Explicit
Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim MyRnge As Range, c As Range
Set MyRnge = Sheet1.Range("A2:A50")
For Each c In MyRnge
    If c.Value <> vbNullString Then
    c.EntireRow.Hidden = False
    Else
    c.EntireRow.Hidden = True
    End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

或者

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim MyRnge As Range, c As Range
Set MyRnge = Sheet1.Range("A2:A50")

If Not Intersect(Target, Range("$B$1")) Is Nothing Then

For Each c In MyRnge
    If c.Value <> vbNullString Then
    c.EntireRow.Hidden = False
    Else
    c.EntireRow.Hidden = True
    End If
Next
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

或者当范围之间的奇数发生变化时隐藏偶数行。

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Not Intersect(Target, Range("$N$21:$N$73")) Is Nothing Then
If Target.Row Mod 2 <> 0 Then
If Target <> vbNullString Then
Rows(Target.Row + 1).Hidden = False
Else
Rows(Target.Row + 1).Hidden = True
End If
End If
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

或隐藏范围之间的下一行

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Not Intersect(Target, Range("$N$21:$N$73")) Is Nothing Then

If Target <> vbNullString Then
Rows(Target.Row + 1).Hidden = False
Else
Rows(Target.Row + 1).Hidden = True
End If
End If


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

清除单元格/范围语法：

Sub ClearApp()
'ClearApp Macro
Cells(14, 6).MergeArea.ClearContents 'clear merged area - you can refer to any of the cells within the merged range. This clears the A14 merged area in your example by referring to F16 within the merged area.
Range("J1:J9,K1:K9").ClearContents 'clear any other area
End Sub

相关内容