Question

我正在尝试在一个worksheet_change中实现多个功能。我之前可以集成3个功能（所有功能都与隐藏/取消隐藏行有关），但是在添加一个允许在下拉列表中进行多项选择的功能时遇到了麻烦。

我试图将新的多重选择代码添加到以前存在的代码中，它不会给我错误，但是不会运行。在理想情况下，它将保留隐藏/取消隐藏功能，并允许在已标识的行中进行多个选择。

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

我希望它能够根据选择继续隐藏/取消隐藏给定的行，并允许从代码中概述的行的下拉列表中进行多次选择。代码没有给我错误，但是多选功能无法运行

Answer 1

我想我明白您正在尝试做的事情，希望这些评论对您的代码有所帮助。有一些评论...

Always use Option Explicit。无论您在Webz上找到什么示例代码，使用此习惯都将对您将来有很大帮助。
在代码中使用中间变量可以使代码自我记录，这是BIG帮助。分配临时值和对象没有任何惩罚，因此请充分利用此优势。
将逻辑块分成单独的子例程或函数。这使您的代码“在功能上是隔离的”-意味着每个代码块都有一个特定的焦点，并且如果您需要更改它，则只需在一个位置进行更改。它还使您的代码更容易阅读，而无需上下滚动以了解整体逻辑。

对于您的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

很显然，我可能没有得到您范围的“点”（使用“组”，“货币”，“值”），但是您应该使用描述性名称，以便于理解什么以及为什么逻辑在某些部分上起作用。

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

在每个逻辑块中（在这种情况下，即在Sub代码中），您应该经历建立确切地被引用的工作表的步骤。始终fully qualify your range references (see #5)至关重要。最简单的方法（没有很长的复合语句）是使用中间变量。

因此，在上面调用的每个“显示”例程中，我都建立了对目标单元格（引起Worksheet事件的单元格）的Worksheet_Change的引用。

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"

所以前三个“显示”例程可能看起来像这样：

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上找到的数据验证/多选代码的麻烦。因此，我将使用一个有一些轻微修改的工具。该代码也包含在常规代码模块中。

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

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

将多个代码集成到一个工作表中

1 个答案: