如何组合两个 vba 代码？删除了多个列表，并显示为其他值

问：

我想组合两个不同的 vba 代码函数。

1. 创建包含项目删除功能的多个列表
2. 将所选项目显示为另一个预定义值

我有两个选项的 vba 代码，见下文。

第一个完全符合我的需求，将项目添加到列表中，并在第二次单击项目时删除项目（因此只有唯一值）。这很重要，因为列表会很长，当你点击错误的列表时，你不想重新开始。

第二个也确实创建了一个多列表并显示相应的较短值。但是这个没有删除项目的功能。由于列表很长，长值需要显示为较短值。而且下拉列表应该是长版本，所以人们不需要努力学习缩写，我仍然可以看到需要什么。

这两个 vba 代码都是由其他人编写的，而不是我写的。我只是用谷歌搜索了它们，我确实了解了一点 vba，但不足以将这两者结合起来或重写一个可以同时做这两件事的新。

是否有可能同时拥有这些功能，如果可以，如何？

额外但不是大问题： 如果我向列表中添加新值以进行选择或更改缩写，则已在下拉列表中选择的值不会更新。是否可以在代码中添加此内容？

我试图将它们结合起来，但我失败了。一个 vba 代码是用目标范围编写的，另一个是用目标范围编写的，所以我认为这是它不能一起工作的原因之一。但我也不够熟练。

第一个：

Option Explicit
Private Sub Worksheet_Change(ByVal Destination As Range)
Dim rngDropdown As Range
Dim oldValue As String
Dim newValue As String
Dim DelimiterType As String
DelimiterType = " | "
Dim DelimiterCount As Integer
Dim TargetType As Integer
Dim i As Integer
Dim arr() As String
 
If Destination.Count > 1 Then Exit Sub
On Error Resume Next
 
Set rngDropdown = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitError
 
If rngDropdown Is Nothing Then GoTo exitError
 
TargetType = 0
    TargetType = Destination.Validation.Type
    If TargetType = 3 Then  ' is validation type is "list"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        newValue = Destination.Value
        Application.Undo
        oldValue = Destination.Value
        Destination.Value = newValue
        If oldValue <> "" Then
            If newValue <> "" Then
                If oldValue = newValue Or oldValue = newValue & Replace(DelimiterType, " ", "") Or oldValue = newValue & DelimiterType Then ' leave the value if there is only one in the list
                    oldValue = Replace(oldValue, DelimiterType, "")
                    oldValue = Replace(oldValue, Replace(DelimiterType, " ", ""), "")
                    Destination.Value = oldValue
                ElseIf InStr(1, oldValue, DelimiterType & newValue) Or InStr(1, oldValue, " " & newValue & DelimiterType) Then
                    arr = Split(oldValue, DelimiterType)
                If Not IsError(Application.Match(newValue, arr, 0)) = 0 Then
                    Destination.Value = oldValue & DelimiterType & newValue
                        Else:
                    Destination.Value = ""
                    For i = 0 To UBound(arr)
                    If arr(i) <> newValue Then
                        Destination.Value = Destination.Value & arr(i) & DelimiterType
                    End If
                    Next i
                Destination.Value = Left(Destination.Value, Len(Destination.Value) - Len(DelimiterType))
                End If
                ElseIf InStr(1, oldValue, newValue & Replace(DelimiterType, " ", "")) Then
                    oldValue = Replace(oldValue, newValue, "")
                    Destination.Value = oldValue
                Else
                    Destination.Value = oldValue & DelimiterType & newValue
                End If
                Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", "") & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", "")) ' remove extra commas and spaces
                Destination.Value = Replace(Destination.Value, DelimiterType & Replace(DelimiterType, " ", ""), Replace(DelimiterType, " ", ""))
                If Destination.Value <> "" Then
                    If Right(Destination.Value, 2) = DelimiterType Then  ' remove delimiter at the end
                        Destination.Value = Left(Destination.Value, Len(Destination.Value) - 2)
                    End If
                End If
                If InStr(1, Destination.Value, DelimiterType) = 1 Then ' remove delimiter as first characters
                    Destination.Value = Replace(Destination.Value, DelimiterType, "", 1, 1)
                End If
                If InStr(1, Destination.Value, Replace(DelimiterType, " ", "")) = 1 Then
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "", 1, 1)
                End If
                DelimiterCount = 0
                For i = 1 To Len(Destination.Value)
                    If InStr(i, Destination.Value, Replace(DelimiterType, " ", "")) Then
                        DelimiterCount = DelimiterCount + 1
                    End If
                Next i
                If DelimiterCount = 1 Then ' remove delimiter if last character
                    Destination.Value = Replace(Destination.Value, DelimiterType, "")
                    Destination.Value = Replace(Destination.Value, Replace(DelimiterType, " ", ""), "")
                End If
            End If
        End If
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
 
exitError:
  Application.EnableEvents = True
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

第二个：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim oldValue As String
    Dim newValue As String
    Dim selectedNum As Variant
    Application.EnableEvents = True
    On Error GoTo Exitsub
    If Target.Column = 2 Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else: If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
                     
            
            newValue = Target.Value
            selectedNum = Application.VLookup(newValue, Worksheets("PPE").Range("ShowAs"), 2, False)
            newValue = selectedNum
            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

我仍在努力弄清楚如何添加我的 excel 文件以使其更清晰。