如果选择了第 4 列或第 5 列并且同一行中的第 2 列具有字符串“has options”，我正在尝试实现添加多选列表框的代码。

列表框包含来自名为“option1”和“option2”的命名范围的值。当前选择输出到第 4 或第 5 列中的相应单元格，以逗号分隔。

这是我在“本工作簿”对象中的代码。它需要适用于所有工作表。

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object,ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Target.Column = 4 And Target.OFFSET(0,-1).Value = "has options" Then
            CreateOpt1PopUp Target
        End If
            If Target.Column = 5 And Target.OFFSET(0,-2).Value = "has options" Then
                CreateOpt2PopUp Target
            End If
        Else
            DeleteAllOpt1PopUps Target
            DeleteAllOpt2PopUps Target
        End If
    End If
End Sub

这是我在模块中的代码。标准已经发展，因此我多次修改代码，直到它不再起作用。

Private opt1SelectCell As Range

Public Function Opt1Area(ByRef ws As Worksheet) As Range
    Const OPT1_COL As Long = 4
    Dim lastOpt1Row As Long
    With ws
        lastOpt1Row = .Cells(.Rows.Count,1).End(xlUp).Row - 1
        If lastOpt1Row = 0 Then
            Set Opt1Area = Nothing
        Else
            Set Opt1Area = .Cells(2,OPT1_COL).Resize(lastOpt1Row,1)
        End If
    End With
End Function

Public Sub Opt1BoxClick()
    Dim opt1BoxName As String
    opt1BoxName = Application.Caller
    
    Dim opt1Box As ListBox
    Set opt1Box = activeSheet.ListBoxes(opt1BoxName)

    Dim opt1List As String
    Dim i As Long
    For i = 1 To opt1Box.ListCount
        If opt1Box.Selected(i) Then
            opt1List = opt1List & opt1Box.List(i) & ","
        End If
    Next i
    If Len(opt1List) > 0 Then
        opt1List = Left$(opt1List,Len(opt1List) - 1)
    End If
    opt1SelectCell.Value = opt1List
End Sub

Public Function Opt1ListArea() As Range
    Set Opt1ListArea = activeSheet.Range("option1")
End Function

Public Sub DeleteAllOpt1PopUps(ByRef selectedCell As Range)
    Dim opt1Box As ListBox
    For Each opt1Box In selectedCell.Parent.ListBoxes
        opt1Box.Delete
    Next opt1Box
End Sub

Public Sub CreateOpt1PopUp(ByRef selectedCell As Range)
    Set opt1SelectCell = selectedCell
    
    Dim Opt1PopUpCell As Range
    Set Opt1PopUpCell = opt1SelectCell.OFFSET(1,0)
    
    DeleteAllOpt1PopUps selectedCell

    '--- now create listbox
    Const OPT1_POPUP_WIDTH As Double = 75
    Const OPT1_POPUP_HEIGHT As Double = 110
    Const OPT1_OFFSET As Double = 5#
    Dim opt1Box As ListBox
    Set opt1Box = activeSheet.ListBoxes.Add(Opt1PopUpCell.Left + OPT1_OFFSET,_
                                              Opt1PopUpCell.Top + OPT1_OFFSET,_
                                              OPT1_POPUP_WIDTH,_
                                              OPT1_POPUP_HEIGHT)
    With opt1Box
        .ListFillRange = Opt1ListArea().Address(external:=True)
        .LinkedCell = ""
        .MultiSelect = xlSimple
        .Display3DShading = True
        .Onaction = "Module1.Opt1BoxClick"
    End With
    
    '--- is there an existing list of options selected?
    Dim selectedOptions1() As String
    selectedOptions1 = Split(opt1SelectCell.Value,",")
    Dim opt1 As Variant
    For Each opt1 In selectedOptions1
        Dim i As Long
        For i = 1 To opt1Box.ListCount
            If opt1Box.List(i) = opt1 Then
                opt1Box.Selected(i) = True
                Exit For
            End If
        Next i
    Next opt1
End Sub

这是excel数据的一个例子。

我怎样才能完成这项工作，甚至改进它？