多码合一Worksheet_Change

Question

我正在尝试将多个功能整合为一个 worksheet_change。我之前能够集成 3 个函数（全部与 hiding/unhiding 行有关），但是，我无法添加允许下拉列表中多个 select 离子的函数。

我已经尝试将新的多重 selection 代码添加到以前存在的代码中，它没有给我错误，但它不会运行。在一个完美的世界中，它会保留 hiding/unhiding 功能，并允许在已识别的行中使用多个 select 离子。

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Activate

If Not Application.Intersect(Range("C10:AA10"), Range(Target.Address)) 

Is Nothing Then
    Select Case Target.Value

    Case Is = "Select One": Rows("14:58").EntireRow.Hidden = True
                         Rows("10").EntireRow.Hidden = False
    Case Is = "1": Rows("17:58").EntireRow.Hidden = True
                        Rows("14:16").EntireRow.Hidden = False
    Case Is = "2":  Rows("20:58").EntireRow.Hidden = True
                        Rows("14:19").EntireRow.Hidden = False
    Case Is = "3": Rows("23:58").EntireRow.Hidden = True
                        Rows("14:22").EntireRow.Hidden = False
    Case Is = "4":  Rows("26:58").EntireRow.Hidden = True
                        Rows("14:25").EntireRow.Hidden = False
    Case Is = "5": Rows("29:58").EntireRow.Hidden = True
                        Rows("14:28").EntireRow.Hidden = False
    Case Is = "6":  Rows("32:58").EntireRow.Hidden = True
                        Rows("14:31").EntireRow.Hidden = False
    Case Is = "7": Rows("35:58").EntireRow.Hidden = True
                        Rows("14:34").EntireRow.Hidden = False
    Case Is = "8":  Rows("38:58").EntireRow.Hidden = True
                        Rows("14:37").EntireRow.Hidden = False
    Case Is = "9": Rows("41:58").EntireRow.Hidden = True
                        Rows("14:40").EntireRow.Hidden = False
    Case Is = "10":  Rows("44:58").EntireRow.Hidden = True
                        Rows("14:43").EntireRow.Hidden = False
    Case Is = "11": Rows("47:58").EntireRow.Hidden = True
                        Rows("14:46").EntireRow.Hidden = False
    Case Is = "12":  Rows("50:58").EntireRow.Hidden = True
                        Rows("14:49").EntireRow.Hidden = False
    Case Is = "13": Rows("30:58").EntireRow.Hidden = True
                        Rows("14:52").EntireRow.Hidden = False
    Case Is = "14":  Rows("56:58").EntireRow.Hidden = True
                        Rows("14:55").EntireRow.Hidden = False
    Case Is = "15":  Rows("14:58").EntireRow.Hidden = False
End Select
End If
If Not Intersect(Range("C66:AA66"), Target) Is Nothing Then
    Select Case Target.Value
    Case "GBP", "USD", "Yuan", "EUR", "LRD", "Select One"
        Rows("67").Hidden = True
    Case "Other"
        Rows("67").Hidden = False

    End Select
End If
If Not Intersect(Range("C11:AA11"), Target) Is Nothing Then
    Select Case Target.Value
    Case "$"
        Rows("13").Hidden = True
        Rows("12").Hidden = False
    Case "%"
        Rows("13").Hidden = False
        Rows("12").Hidden = True
    Case "Select One"
        Rows("13").Hidden = True
        Rows("12").Hidden = True

    End Select
End If
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Row = "15",”18”,”21” Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
 Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True

End Sub

我希望它能够继续 hiding/unhiding 基于 select 离子的给定行，并允许从行中的下拉列表中选择多个 select在代码中概述。代码没有给我报错，但是multi-select没有运行

Answer 1

我想我明白你想做什么，我希望这些评论能对你的代码有所帮助。所以一些评论...

Always use Option Explicit。不管你在webz上找到什么示例代码，养成这个习惯对你以后都有很大的帮助。
在你的代码中使用中间变量是一个很大的帮助，使代码成为 self-documenting。分配临时值和对象没有惩罚，因此请利用它。
将逻辑块分离成单独的子例程或函数。这使您的代码 "functionally isolated" —— 这意味着每个代码块都有一个特定的焦点，如果您需要更改它，您只需在一个位置进行更改。它还使您的代码更易于阅读，而无需上下滚动以了解整体逻辑。

对于您的 Worksheet_Change 事件代码，我可以将逻辑简化为更容易理解的流程：

Option Explicit

Private Sub Worksheet_Change(ByVal target As Range)
    Dim groupsRange As Range
    Dim currencyRange As Range
    Dim valuesRange As Range
    Set groupsRange = ActiveSheet.Range("C10:AA10")
    Set currencyRange = ActiveSheet.Range("C66:AA66")
    Set valuesRange = ActiveSheet.Range("C11:AA11")

    If Not Intersect(groupsRange, target) Is Nothing Then
        ShowActiveGroups target
    ElseIf Not Intersect(currencyRange, target) Is Nothing Then
        ShowCurrency target
    ElseIf Not Intersect(valuesRange, target) Is Nothing Then
        ShowValues target
    End If

    If target.Count > 1 Then Exit Sub

    If (target.Row = 15) Or (target.Row = 18) Or (target.Row = 21) Then
        CheckMultiSelect target
    End If
End Sub

显然，我可能无法获得您的范围的 "point"（使用 "groups"、"currency"、"values"），但您应该使用描述性名称，可以更轻松地理解逻辑在某些部分起作用的原因和原因。

在 Worksheet_Change 事件中调用的 Subs 的代码被放置在一个单独的模块中，并且所有代码都被标记为 Public。他们每个人都有相似的逻辑，这里有一些东西在起作用。

在每个逻辑块中（即在本例中的 Sub 代码中），您应该完成确切正在引用哪个工作表的步骤。始终 fully qualify your range references (see #5) 至关重要。最简单的方法（不需要很长的复合语句）是使用中间变量。

因此，在上面调用的每个 "Show" 例程中，我都设置了对目标单元格（导致 Worksheet_Change 事件的单元格）的 Worksheet 的引用。

Dim targetWS As Worksheet
Set targetWS = target.Parent

尝试为看似 "random" 的数字或在工作表上下文之外没有实际意义的值定义常量。

在您的例子中，您引用了许多不同的行并且 hiding/unhiding 它们。我不知道为什么。但是，如果您可以 "name" 代码中的行，它可能更有意义。以下是我使用的一些示例：

Const RED_GROUP_1 As String = "14:58"
Const RED_GROUP_2 As String = "10"
Const GREEN_GROUP_1 As String = "17:58"
Const GREEN_GROUP_2 As String = "14:16"

因此前三个 "Show" 例程可能如下所示：

Public Sub ShowActiveGroups(ByRef target As Range)
    Dim targetWS As Worksheet
    Set targetWS = target.Parent

    Const RED_GROUP_1 As String = "14:58"
    Const RED_GROUP_2 As String = "10"
    Const GREEN_GROUP_1 As String = "17:58"
    Const GREEN_GROUP_2 As String = "14:16"

    With targetWS
        Select Case target.Value
            Case "Select One"
                .Rows(RED_GROUP_1).EntireRow.Hidden = True
                .Rows(RED_GROUP_2).EntireRow.Hidden = False
            Case 1
                .Rows(GREEN_GROUP_1).EntireRow.Hidden = True
                .Rows(GREEN_GROUP_2).EntireRow.Hidden = False
            Case 2
                .Rows("20:58").EntireRow.Hidden = True
                .Rows("14:19").EntireRow.Hidden = False

            ' ...

            Case Else
                '--- what should we do if it's not a valid value?
        End Select
    End With
End Sub

Public Sub ShowCurrency(ByRef target As Range)
    Dim targetWS As Worksheet
    Set targetWS = target.Parent

    Const CURRENCY_LINE As String = "67"

    With targetWS
        Select Case target.Value
            Case "GBP", "USD", "Yuan", "EUR", "LRD", "Select One"
                .Rows(CURRENCY_LINE).EntireRow.Hidden = True
            Case "Other"
                .Rows(CURRENCY_LINE).EntireRow.Hidden = False
            Case Else
                '--- what should we do if it's not a valid value?
        End Select
    End With
End Sub

Public Sub ShowValues(ByRef target As Range)
    Dim targetWS As Worksheet
    Set targetWS = target.Parent

    Const MONEY_LINE As String = "13"
    Const PERCENT_LINE As String = "12"

    With targetWS
        Select Case target.Value
            Case "$"
                .Rows(MONEY_LINE).EntireRow.Hidden = True
                .Rows(PERCENT_LINE).EntireRow.Hidden = False
            Case "%"
                .Rows(MONEY_LINE).EntireRow.Hidden = False
                .Rows(PERCENT_LINE).EntireRow.Hidden = True
            Case "Select One"
                .Rows(MONEY_LINE).EntireRow.Hidden = True
                .Rows(PERCENT_LINE).EntireRow.Hidden = True
            Case Else
                '--- what should we do if it's not a valid value?
        End Select
    End With
End Sub

最后，我总是对您在 webz 上找到的 data-validation/multi-select 代码感到困惑。所以我扔进了我使用的那个有几个轻微的模组。此代码也进入常规代码模块。

Public Sub CheckMultiSelect(ByRef target As Range)
    Dim targetWS As Worksheet
    Set targetWS = target.Parent

    On Error Resume Next
    Dim dvCheck As Range
    Set dvCheck = targetWS.Cells.SpecialCells(xlCellTypeAllValidation)
    If dvCheck Is Nothing Then Exit Sub

    Application.EnableEvents = False
    '--- only allow multi-select if the cell has defined data validation
    If Not Intersect(dvCheck, target) Is Nothing Then
        Dim currentValue As String
        Dim oldValue As String
        currentValue = target.Value
        Application.Undo
        oldValue = target.Value
        If oldValue = vbNullString Then
            target.Value = currentValue
        Else
            If InStr(1, oldValue, currentValue) = 0 Then
                target.Value = oldValue & "," & currentValue
            Else
                If currentValue = vbNullString Then
                    target.Value = vbNullString
                Else
                    target.Value = oldValue
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

在工作表模块和常规代码模块中使用上面的代码，我成功地能够执行您原始问题中的一些操作。

多码合一Worksheet_Change

Integrating Multiple Codes into One Worksheet_Change

macos

excel

vba

worksheet-function