Vyberte více položek v rozevíracím seznamu aplikace Excel – úplný průvodce

Rozbalovací seznamy Excelu jsou fantastickým nástrojem pro zajištění konzistence dat a snadného zadávání. Ve výchozím nastavení vás však omezují na výběr pouze jedné položky. Co když ale potřebujete vybrat více položek ze stejného rozevíracího seznamu? Tato komplexní příručka prozkoumá metody umožňující vícenásobný výběr v rozevíracích seznamech aplikace Excel, správu duplikátů, nastavení vlastních oddělovačů a definování rozsahu těchto seznamů.

• Pomocí kódu VBA
• Použití Kutools pro Excel několika kliknutími

• Povolení duplicitních položek
• Odstranění všech existujících položek
• Nastavení vlastního oddělovače
• Nastavení zadaného rozsahu
• Spuštění v chráněném listu

Povolení vícenásobných výběrů v rozevíracím seznamu

Tato část poskytuje dvě metody, které vám pomohou povolit vícenásobný výběr v rozevíracím seznamu v aplikaci Excel.

Pomocí kódu VBA

Chcete-li povolit více výběrů v rozevíracím seznamu, můžete v Excelu použít "Visual Basic for Applications" (VBA). Skript může upravit chování rozevíracího seznamu tak, aby z něj udělal seznam s více možnostmi. Postupujte prosím následovně.

Krok 1: Otevřete editor listu (kódu).

1. Otevřete list obsahující rozevírací seznam, pro který chcete povolit vícenásobný výběr.
2. Klikněte pravým tlačítkem na záložku listu a z kontextové nabídky vyberte "Zobrazit kód".
   

Krok 2: Použijte kód VBA

Nyní zkopírujte následující kód VBA a vložte jej do okna úvodního listu (kódu).

Kód VBA: Povolte vícenásobný výběr v rozevíracím seznamu aplikace 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

Výsledek

Když se vrátíte do listu, rozevírací seznam vám umožní vybrat více možností, viz ukázka níže:

Použití Kutools pro Excel několika kliknutími

Pokud vám VBA nevyhovuje, jednodušší alternativou je funkce „Rozbalovací seznam s více výběry“ v „Kutools pro Excel“. Tento uživatelsky přívětivý nástroj zjednodušuje umožnění vícenásobného výběru v rozevíracích seznamech, což vám umožňuje přizpůsobit oddělovač a snadno spravovat duplikáty tak, aby vyhovovaly vašim různým potřebám.

Po instalaci Kutools pro Excel, přejděte na kartu "Kutools", vyberte "Rozbalovací seznam" > "Rozbalovací seznam s více výběry". Poté je třeba nakonfigurovat následovně.

1. Zadejte rozsah obsahující rozevírací seznam, ze kterého potřebujete vybrat více položek.
2. V buňce rozevíracího seznamu zadejte oddělovač pro vybrané položky.
3. Klikněte na "OK" pro dokončení nastavení.
   

Výsledek

Nyní, když kliknete na buňku s rozevíracím seznamem v určeném rozsahu, zobrazí se vedle ní seznam. Jednoduše klikněte na tlačítko „+“ vedle položek, abyste je přidali do rozevírací buňky, a kliknutím na tlačítko „-“ odstraňte položky, které již nechcete. Podívejte se na ukázku níže:

Další operace pro rozevírací seznam s vícenásobným výběrem

Tato část shromažďuje různé scénáře, které mohou být vyžadovány při povolení více výběrů v rozevíracím seznamu Ověření dat.

Povolení duplicitních položek v rozevíracím seznamu

Pokud je v rozevíracím seznamu povoleno více výběrů, mohou být duplikáty problémem. Výše uvedený kód VBA neumožňuje duplicitní položky v rozevíracím seznamu. Pokud si potřebujete ponechat duplicitní položky, vyzkoušejte kód VBA v této části.

Kód VBA: Povolit duplikáty v rozevíracím seznamu ověření dat

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

Výsledek

Nyní můžete vybrat více položek z rozevíracích seznamů v aktuálním listu. Chcete-li opakovat položku v buňce rozevíracího seznamu, pokračujte ve výběru této položky ze seznamu. Viz snímek obrazovky:

Odebrání všech existujících položek z rozevíracího seznamu

Po výběru více položek z rozevíracího seznamu může být někdy nutné odstranit existující položku z buňky rozevíracího seznamu. Tato část poskytuje další část kódu VBA, která vám pomůže tento úkol splnit.

Kód VBA: Odeberte všechny existující položky z buňky rozevíracího seznamu

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

Výsledek

Tento kód VBA vám umožňuje vybrat více položek z rozevíracího seznamu a snadno odstranit jakoukoli položku, kterou jste již vybrali. Chcete-li po výběru více položek odebrat konkrétní, jednoduše ji znovu vyberte ze seznamu.

Nastavení vlastního oddělovače

Ve výše uvedených kódech VBA je oddělovač nastaven jako čárka. Tuto proměnnou můžete upravit na jakýkoli preferovaný znak, který se použije jako oddělovač pro výběry v rozevíracím seznamu. Postup:

Jak můžete vidět, všechny výše uvedené kódy VBA mají následující řádek:

delimiter = ", "

Stačí změnit čárku na libovolný oddělovač, jak potřebujete. Chcete-li například oddělit položky středníkem, změňte řádek na:

delimiter = "; "

delimiter = vbNewLine

Nastavení zadaného rozsahu

Výše uvedené kódy VBA platí pro všechny rozevírací seznamy v aktuálním listu. Pokud chcete, aby se kódy VBA vztahovaly pouze na určitý rozsah rozevíracích seznamů, můžete rozsah zadat ve výše uvedeném kódu VBA následovně.

Jak můžete vidět, všechny výše uvedené kódy VBA mají následující řádek:

Set TargetRange = Me.UsedRange

Stačí změnit řádek na:

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

Spuštění v chráněném listu

Představte si, že jste chránili pracovní list heslem „123“ a před aktivací ochrany nastavte buňky rozevíracího seznamu na „Odemčeno“, čímž zajistíte, že funkce vícenásobného výběru zůstane aktivní i po ochraně. Výše uvedené kódy VBA však v tomto případě nemohou fungovat a tato část popisuje další skript VBA, který je speciálně navržen pro práci s funkcemi vícenásobného výběru v chráněném listu.

Kód VBA: Povolí vícenásobný výběr v rozevíracím seznamu bez duplicit

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

Povolením více výběrů v rozevíracích seznamech aplikace Excel můžete výrazně zlepšit funkčnost a flexibilitu svých listů. Ať už vám vyhovuje kódování VBA nebo preferujete přímočařejší řešení, jako je Kutools, nyní máte možnost transformovat své standardní rozevírací seznamy na dynamické nástroje s více možnostmi výběru. Díky těmto dovednostem jste nyní vybaveni k vytváření dynamičtějších a uživatelsky přívětivějších dokumentů aplikace Excel. Pro ty, kteří se chtějí hlouběji ponořit do možností Excelu, se náš web může pochlubit velkým množstvím výukových programů. Zde najdete další tipy a triky pro Excel.

Související články