Падащите списъци на Excel са фантастичен инструмент за осигуряване на последователност на данните и лесно въвеждане. По подразбиране обаче те ви ограничават до избора само на един елемент. Но какво ще стане, ако трябва да изберете няколко елемента от един и същ падащ списък? Това изчерпателно ръководство ще изследва методите за активиране на множество селекции в падащите списъци на Excel, управление на дубликати, задаване на персонализирани разделители и дефиниране на обхвата на тези списъци.

• Използване на VBA код
• Използване на Kutools за Excel с няколко кликвания

• Разрешаване на дублирани елементи
• Премахване на всички съществуващи елементи
• Задаване на персонализиран разделител
• Задаване на определен диапазон
• Изпълнение в защитен работен лист

Разрешаване на множество селекции в падащия списък

Този раздел предоставя два метода, които да ви помогнат да активирате множество селекции в падащия списък в Excel.

Използване на VBA код

За да позволите множество селекции в падащия списък, можете да използвате Visual Basic за приложения (VBA) в Excel. Скриптът може да промени поведението на падащ списък, за да го направи списък с множество възможности за избор. Моля, направете следното.

Стъпка 1: Отворете редактора на лист (код).

1. Отворете работния лист, който съдържа падащия списък, за който искате да активирате множествен избор.
2. Щракнете с десния бутон върху раздела на листа и изберете Преглед на кода от контекстното меню.
   

Стъпка 2: Използвайте VBA код

Сега копирайте следния код на VBA и го поставете в прозореца на началния лист (Код).

VBA код: Разрешете множество селекции в падащия списък на Excel.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range

    Set TargetRange = Me.UsedRange ' Users can change target range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        If Not (xValue1 = xValue2 Or _
                InStr(1, xValue1, delimiter & xValue2) > 0 Or _
                InStr(1, xValue1, xValue2 & delimiter) > 0) Then
            Target.Value = xValue1 & delimiter & xValue2
        Else
            Target.Value = xValue1
        End If
    End If

    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Резултат

Когато се върнете към работния лист, падащият списък ще ви позволи да изберете няколко опции, вижте демонстрацията по-долу:

Използване на Kutools за Excel с няколко кликвания

Ако не се чувствате удобно с VBA, по-лесна алтернатива е Kutools за Excel's Падащ списък с множество избори особеност. Този удобен за потребителя инструмент опростява активирането на множество селекции в падащи списъци, което ви позволява да персонализирате разделителя и да управлявате дубликати без усилие, за да отговорите на различните си нужди.

След инсталиране на Kutools за Excel, отидете на Kutools , изберете Падащ списък > Падащ списък с множество избори. След това трябва да конфигурирате, както следва.

1. Посочете диапазона, съдържащ падащия списък, от който трябва да изберете няколко елемента.
2. Посочете разделителя за избраните елементи в клетката на падащия списък.
3. Кликнете OK за да завършите настройките.
   

Резултат

Сега, когато щракнете върху клетка с падащ списък в посочения диапазон, до нея ще се появи списъчно поле. Просто щракнете върху бутона „+“ до елементите, за да ги добавите към клетката с падащо меню, и щракнете върху бутона „-“, за да премахнете всички елементи, които вече не искате. Вижте демонстрацията по-долу:

Още операции за падащ списък с множество избори

Този раздел събира различните сценарии, които може да са необходими при активиране на множество селекции в падащия списък Проверка на данни.

Разрешаване на дублирани елементи в падащия списък

Дубликатите могат да бъдат проблем, когато са разрешени множество селекции в падащ списък. Кодът на VBA по-горе не позволява дублирани елементи в падащия списък. Ако трябва да запазите дублиращи се елементи, опитайте кода на VBA в този раздел.

VBA код: Разрешаване на дубликати в падащия списък за проверка на данни

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range

    Set TargetRange = Me.UsedRange ' Users can change target range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        Target.Value = xValue1 & delimiter & xValue2
    End If

    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Резултат

Сега можете да изберете няколко елемента от падащите списъци в текущия работен лист. За да повторите елемент в клетка от падащ списък, продължете да избирате този елемент от списъка. Вижте екранна снимка:

Премахване на всички съществуващи елементи от падащия списък

След като изберете няколко елемента от падащ списък, понякога може да се наложи да премахнете съществуващ елемент от клетката на падащия списък. Този раздел предоставя друга част от VBA код, за да ви помогне да изпълните тази задача.

VBA код: Премахнете всички съществуващи елементи от клетката на падащия списък

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 20240118
    Dim xRngDV As Range
    Dim TargetRange As Range
    Dim oldValue As String
    Dim newValue As String
    Dim delimiter As String
    Dim allValues As Variant
    Dim valueExists As Boolean
    Dim i As Long
    Dim cleanedValue As String

    Set TargetRange = Me.UsedRange ' Set your specific range here
    delimiter = ", " ' Set your desired delimiter here

    If Target.CountLarge > 1 Then Exit Sub

    ' Check if the change is within the specific range
    If Intersect(Target, TargetRange) Is Nothing Then Exit Sub

    On Error Resume Next
    Set xRngDV = Target.SpecialCells(xlCellTypeAllValidation)
    If xRngDV Is Nothing Or Target.Value = "" Then
        ' Skip if there's no data validation or if the cell is cleared
        Application.EnableEvents = True
        Exit Sub
    End If
    On Error GoTo 0

    If Not Intersect(Target, xRngDV) Is Nothing Then
        Application.EnableEvents = False
        newValue = Target.Value
        Application.Undo
        oldValue = Target.Value
        Target.Value = newValue

        ' Split the old value by delimiter and check if new value already exists
        allValues = Split(oldValue, delimiter)
        valueExists = False
        For i = LBound(allValues) To UBound(allValues)
            If Trim(allValues(i)) = newValue Then
                valueExists = True
                Exit For
            End If
        Next i

        ' Add or remove value based on its existence
        If valueExists Then
            ' Remove the value
            cleanedValue = ""
            For i = LBound(allValues) To UBound(allValues)
                If Trim(allValues(i)) <> newValue Then
                    If cleanedValue <> "" Then cleanedValue = cleanedValue & delimiter
                    cleanedValue = cleanedValue & Trim(allValues(i))
                End If
            Next i
            Target.Value = cleanedValue
        Else
            ' Add the value
            If oldValue <> "" Then
                Target.Value = oldValue & delimiter & newValue
            Else
                Target.Value = newValue
            End If
        End If

        Application.EnableEvents = True
    End If
End Sub

Резултат

Този VBA код ви позволява да изберете няколко елемента от падащ списък и лесно да премахнете всеки елемент, който вече сте избрали. След като изберете няколко елемента, ако искате да премахнете конкретен, просто го изберете отново от списъка.

Задаване на персонализиран разделител

Разделителят е зададен като запетая в горните VBA кодове. Можете да модифицирате тази променлива на всеки предпочитан знак, който да използвате като разделител за селекциите в падащия списък. Ето как можете да направите:

Както можете да видите, всички горни VBA кодове имат следния ред:

delimiter = ", "

Просто трябва да промените запетаята на произволен разделител, както ви е необходимо. Например, искате да разделите елементите с точка и запетая, променете реда на:

delimiter = "; "

delimiter = vbNewLine

Задаване на определен диапазон

Горните VBA кодове се прилагат за всички падащи списъци в текущия работен лист. Ако искате VBA кодовете да се прилагат само към определен диапазон от падащи списъци, можете да посочите диапазона в горния VBA код, както следва.

Както можете да видите, всички горни VBA кодове имат следния ред:

Set TargetRange = Me.UsedRange

Просто трябва да промените реда на:

Set TargetRange = Me.Range("C2:C10")

Изпълнение в защитен работен лист

Представете си, че сте защитили работен лист с паролата "123" и задайте клетките на падащия списък на "Unlocked", преди да активирате защитата, като по този начин гарантирате, че функцията за множествен избор остава активна след защитата. Въпреки това VBA кодовете, споменати по-горе, не могат да работят в този случай и този раздел описва друг VBA скрипт, който е специално проектиран да обработва функционалност за множествен избор в защитен работен лист.

VBA код: Разрешете множествен избор в падащия списък без дубликати

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range
    Dim isProtected As Boolean
    Dim pswd As Variant

    Set TargetRange = Me.UsedRange ' Set your specific range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    
    ' Check if sheet is protected
    isProtected = Me.ProtectContents
    If isProtected Then
        ' If protected, temporarily unprotect. Adjust or remove the password as needed.
        pswd = "yourPassword" ' Change or remove this as needed
        Me.Unprotect Password:=pswd
    End If

    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then
        If isProtected Then Me.Protect Password:=pswd
        Exit Sub
    End If
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        If Not (xValue1 = xValue2 Or _
                InStr(1, xValue1, delimiter & xValue2) > 0 Or _
                InStr(1, xValue1, xValue2 & delimiter) > 0) Then
            Target.Value = xValue1 & delimiter & xValue2
        Else
            Target.Value = xValue1
        End If
    End If

    Application.EnableEvents = True
    On Error GoTo 0

    ' Re-protect the sheet if it was protected
    If isProtected Then
        Me.Protect Password:=pswd
    End If
End Sub

Като активирате множество селекции в падащите списъци на Excel, можете значително да подобрите функционалността и гъвкавостта на вашите работни листове. Независимо дали се чувствате комфортно с кодирането на VBA или предпочитате по-просто решение като Kutools, вече имате възможността да трансформирате стандартните си падащи списъци в динамични инструменти за многократен избор. С тези умения вече сте подготвени да създавате по-динамични и лесни за използване Excel документи. За онези, които желаят да навлязат по-дълбоко във възможностите на Excel, нашият уебсайт може да се похвали с изобилие от уроци. Открийте още съвети и трикове за Excel тук.

Свързани статии