将两个专用子工作表_Change合并到一张工作表上



我希望你能帮助我。我有一个工作簿,我正在尝试根据一个下拉选择做两件事。在选择中,我有1、2或3。基于此,我想隐藏页面上的一些行,以及某些页面。

我能够使用第一部分来隐藏某些行。我可以用第二部分把床单藏起来。我在不同的工作簿中测试了它们,它们都有效。有没有办法把它们结合起来?

我真的很感激对这个问题的任何见解

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("$B$8:$C$8"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "1": Range("A35:A42,A50,A55:A57").EntireRow.Hidden = False
Rows("12").EntireRow.Hidden = True
Case Is = "2": Range("A35:A42,A50,A55:A57").EntireRow.Hidden = True
Rows("12").EntireRow.Hidden = False

Case Is = "3": Range("A12,A35:A42,A50,A55:A57").EntireRow.Hidden = True
End Select
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Application.Volatile
Select Case Worksheets("INPUT").Range("B8").Value
Case "1"
Worksheets("A").Visible = False
Worksheets("B").Visible = True
Worksheets("C").Visible = False
Worksheets("D").Visible = False
Worksheets("E").Visible = True

Case "2"
Worksheets("A").Visible = False
Worksheets("B").Visible = False
Worksheets("C").Visible = True
Worksheets("D").Visible = True
Worksheets("E").Visible = False

Case "3"
Worksheets("A").Visible = True
Worksheets("B").Visible = True
Worksheets("C").Visible = False
Worksheets("D").Visible = False
Worksheets("E").Visible = False

End Select
End Sub

我将创建两个子例程来隐藏行和隐藏表。两者都从您的目标范围(1、2或3(中获取值,并相应地采取行动。

优点:当您阅读worksheet_change事件中的代码时,您可以在不阅读详细代码的情况下立即从高层了解正在发生的事情。

在子程序中;选择大小写";以避免重复代码。如果要处理更多的行或表,您只需在一个地方进行调整。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("$B$8:$C$8"), Range(Target.Address)) Is Nothing Then
hideShowSpecialRows Target.value
hideShowSpecialSheets Target.value
End If

End Sub
'These routines could also go into a normal module
Public Sub hideShowSpecialRows(value As Long)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("XXXXX")   'adjust to your needs

ws.Rows(12).Hidden = CBool(value = 1 Or value = 3)

Dim arrRows(2) As String, i As Long
arrRows(0) = "35:42"
arrRows(1) = "50"
arrRows(2) = "55:57"

For i = 0 To UBound(arrRows)
ws.Rows(arrRows(i)).Hidden = CBool(value = 2 Or value = 3)
Next
End Sub
Public Sub hideShowSpecialSheets(value As Long)

With ThisWorkbook
.Worksheets("A").Visible = CBool(value = 3)
.Worksheets("B").Visible = CBool(value = 1 Or value = 3)
.Worksheets("C").Visible = CBool(value = 2)
.Worksheets("D").Visible = CBool(value = 2)
.Worksheets("E").Visible = CBool(value = 1)
End With
End Sub

隐藏行和工作表的工作表更改

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sCellAddress As String = "B8"
Dim sCell As Range: Set sCell = Intersect(Range(sCellAddress), Target)
If Not sCell Is Nothing Then
ShowHide sCell
End If
End Sub
Sub ShowHide( _
ByVal SourceCell As Range)
Application.ScreenUpdating = False
ShowHideRanges SourceCell
ShowHideWorksheets SourceCell
Application.ScreenUpdating = True
End Sub
Sub ShowHideRanges( _
ByVal SourceCell As Range)
Dim ws As Worksheet: Set ws = SourceCell.Worksheet
Dim sValue As Long: sValue = CLng(SourceCell.Value)
ws.Range("35:42,50:50,55:57").EntireRow.Hidden = CBool(sValue - 1) ' F,T,T
ws.Range("12:12").EntireRow.Hidden = CBool(sValue Mod 2) ' T,F,T
End Sub
Sub ShowHideWorksheets( _
ByVal SourceCell As Range)
Const dNamesList As String = "A,B,C,D,E"
Dim dNames() As String: dNames = Split(dNamesList, ",")
Dim sValue As Long: sValue = CLng(SourceCell.Value)
Dim wb As Workbook: Set wb = SourceCell.Worksheet.Parent
wb.Worksheets(dNames(0)).Visible = CBool(sValue = 3) ' F,F,T
wb.Worksheets(dNames(1)).Visible = CBool(sValue <> 2) ' T,F,T
wb.Worksheets(dNames(2)).Visible = CBool(sValue = 2) ' F,T,F
wb.Worksheets(dNames(3)).Visible = CBool(sValue = 2) ' F,T,F
wb.Worksheets(dNames(4)).Visible = CBool(sValue = 1) ' T,F,F
End Sub

最新更新