在一張紙上合并兩個PrivateSubWorkSheet_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

uj5u.com熱心網友回復：

我會創建兩個子程式來隱藏行和隱藏作業表。兩者都從您的目標范圍（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

uj5u.com熱心網友回復：

隱藏行和作業表的作業表更改

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

標籤：擅长 vba

上一篇：如何使用VBA洗掉Excel宏中兩列的重復項？

下一篇：在VBA中繼續回圈sub1到sub3