![根据该行单元格上显示的基于公式的结果隐藏/取消隐藏行](https://linux22.com/image/1622224/%E6%A0%B9%E6%8D%AE%E8%AF%A5%E8%A1%8C%E5%8D%95%E5%85%83%E6%A0%BC%E4%B8%8A%E6%98%BE%E7%A4%BA%E7%9A%84%E5%9F%BA%E4%BA%8E%E5%85%AC%E5%BC%8F%E7%9A%84%E7%BB%93%E6%9E%9C%E9%9A%90%E8%97%8F%2F%E5%8F%96%E6%B6%88%E9%9A%90%E8%97%8F%E8%A1%8C.png)
我正在努力寻找一个 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