Mae cwymplenni Excel yn arf gwych ar gyfer sicrhau cysondeb data a rhwyddineb mynediad. Fodd bynnag, yn ddiofyn, maent yn eich cyfyngu i ddewis un eitem yn unig. Ond beth os oes angen i chi ddewis eitemau lluosog o'r un gwymplen? Bydd y canllaw cynhwysfawr hwn yn archwilio dulliau i alluogi detholiadau lluosog mewn cwymplenni Excel, rheoli copïau dyblyg, gosod gwahanyddion arfer, a diffinio cwmpas y rhestrau hyn.

• Gan ddefnyddio cod VBA
• Defnyddio Kutools ar gyfer Excel mewn ychydig o gliciau

• Caniatáu eitemau dyblyg
• Cael gwared ar unrhyw eitemau presennol
• Gosod gwahanydd personol
• Gosod ystod benodol
• Gweithredu mewn taflen waith warchodedig

Galluogi Dewisiadau Lluosog yn y Rhestr Gollwng

Mae'r adran hon yn darparu dau ddull i'ch helpu i alluogi detholiadau lluosog yn y gwymplen yn Excel.

Gan ddefnyddio Cod VBA

Er mwyn caniatáu dewis lluosog yn y gwymplen, gallwch ei ddefnyddio Sylfaenol weledol ar gyfer cymwysiadau (VBA) yn Excel. Gall y sgript addasu ymddygiad rhestr gwympo i'w gwneud yn rhestr amlddewis. Gwnewch fel a ganlyn.

Cam 1: Agorwch y golygydd Dalen (Cod).

1. Agorwch y daflen waith sy'n cynnwys y gwymplen yr ydych am alluogi dewis lluosog ar ei chyfer.
2. De-gliciwch ar y tab taflen a dewiswch Gweld y Cod o'r ddewislen cyd-destun.
   

Cam 2: Defnyddiwch god VBA

Nawr copïwch y cod VBA canlynol a'i gludo i ffenestr y daflen agoriadol (Cod).

Cod VBA: Galluogi dewisiadau lluosog yn y gwymplen 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

Canlyniad

Pan fyddwch yn dychwelyd i'r daflen waith, bydd y gwymplen yn eich galluogi i ddewis opsiynau lluosog, gweler y demo isod:

Defnyddio Kutools ar gyfer Excel mewn ychydig o gliciau

Os nad ydych chi'n gyfforddus â VBA, dewis arall haws yw Kutools ar gyfer Excel's Rhestr Gollwng Aml-ddewis nodwedd. Mae'r offeryn hawdd ei ddefnyddio hwn yn symleiddio'r broses o alluogi detholiadau lluosog mewn cwymplenni, sy'n eich galluogi i addasu'r gwahanydd a rheoli copïau dyblyg yn ddiymdrech i ddiwallu'ch anghenion gwahanol.

Ar ôl gosod Kutools ar gyfer Excel, ewch i'r Kutools tab, dewiswch Rhestr ostwng > Rhestr Gollwng Aml-ddewis. Yna mae angen i chi ffurfweddu fel a ganlyn.

1. Nodwch yr ystod sy'n cynnwys y gwymplen y mae angen i chi ddewis eitemau lluosog ohoni.
2. Nodwch y gwahanydd ar gyfer yr eitemau a ddewiswyd yn y gell rhestr gwympo.
3. Cliciwch OK i gwblhau'r gosodiadau.
   

Canlyniad

Nawr, pan fyddwch chi'n clicio ar gell gyda gwymplen yn yr ystod benodedig, bydd blwch rhestr yn ymddangos wrth ei ymyl. Yn syml, cliciwch ar y botwm "+" wrth ymyl yr eitemau i'w hychwanegu at y gwymplen, a chliciwch ar y botwm "-" i gael gwared ar unrhyw eitemau nad ydych chi eu heisiau mwyach. Gweler y demo isod:

Mwy o weithrediadau ar gyfer rhestr gwympo aml-ddewis

Mae'r adran hon yn casglu'r gwahanol senarios a all fod yn ofynnol wrth alluogi detholiadau lluosog yn y gwymplen Dilysu Data.

Caniatáu eitemau dyblyg yn y gwymplen

Gall copïau dyblyg fod yn broblem pan ganiateir dewis lluosog mewn cwymprestr. Nid yw'r cod VBA uchod yn caniatáu eitemau dyblyg yn y gwymplen. Os oes angen i chi gadw eitemau dyblyg, rhowch gynnig ar y cod VBA yn yr adran hon.

Cod VBA: Caniatáu dyblygu yn y gwymplen dilysu data

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

Canlyniad

Nawr gallwch ddewis eitemau lluosog o'r cwymplenni yn y daflen waith gyfredol. I ailadrodd eitem mewn cell rhestr gwympo, parhewch i ddewis yr eitem honno o'r rhestr. Gweler y sgrinlun:

Tynnu unrhyw eitemau presennol o'r gwymplen

Ar ôl dewis eitemau lluosog o gwymplen, efallai y bydd angen i chi weithiau dynnu eitem sy'n bodoli eisoes o'r gell rhestr ostwng. Mae'r adran hon yn darparu darn arall o god VBA i'ch helpu i gyflawni'r dasg hon.

Cod VBA: Tynnwch unrhyw eitemau presennol o'r gell rhestr ostwng

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

Canlyniad

Mae'r cod VBA hwn yn eich galluogi i ddewis eitemau lluosog o gwymplen a thynnu unrhyw eitem rydych chi eisoes wedi'i dewis yn hawdd. Ar ôl dewis eitemau lluosog, os ydych chi am gael gwared ar un penodol, dewiswch hi eto o'r rhestr.

Gosod gwahanydd personol

Mae'r amffinydd wedi'i osod fel coma yn y codau VBA uchod. Gallwch addasu'r newidyn hwn i unrhyw nod a ffefrir i'w ddefnyddio fel gwahanydd ar gyfer y dewisiadau rhestr gwympo. Dyma sut y gallwch chi wneud:

Fel y gwelwch, mae gan bob un o'r codau VBA uchod y llinell ganlynol:

delimiter = ", "

Does ond angen i chi newid y coma i unrhyw wahanydd yn ôl yr angen. Er enghraifft, rydych chi am wahanu'r eitemau yn ôl hanner colon, newidiwch y llinell i:

delimiter = "; "

delimiter = vbNewLine

Gosod ystod benodol

Mae'r codau VBA uchod yn berthnasol i'r holl gwymplenni yn y daflen waith gyfredol. Os ydych chi am i'r codau VBA fod yn berthnasol i ystod benodol o restrau cwympo yn unig, gallwch chi nodi'r ystod yn y cod VBA uchod fel a ganlyn.

Fel y gwelwch, mae gan bob un o'r codau VBA uchod y llinell ganlynol:

Set TargetRange = Me.UsedRange

Does ond angen i chi newid y llinell i:

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

Gweithredu mewn taflen waith warchodedig

Dychmygwch eich bod wedi diogelu taflen waith gyda'r cyfrinair "123" a gosodwch gelloedd y rhestr gwympo i "ddatgloi" cyn actifadu'r amddiffyniad, gan sicrhau bod y swyddogaeth aml-ddewis yn parhau'n weithredol ar ôl yr amddiffyniad. Fodd bynnag, ni all y codau VBA a grybwyllir uchod weithio yn yr achos hwn, ac mae'r adran hon yn disgrifio sgript VBA arall sydd wedi'i chynllunio'n benodol i drin swyddogaeth aml-ddewis mewn taflen waith warchodedig.

Cod VBA: Galluogi dewis lluosog yn y gwymplen heb ddyblygiadau

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

Trwy alluogi dewisiadau lluosog mewn cwymplenni Excel, gallwch wella ymarferoldeb a hyblygrwydd eich taflenni gwaith yn fawr. P'un a ydych chi'n gyfforddus â chodio VBA neu'n well gennych ddatrysiad symlach fel Kutools, mae gennych nawr y gallu i drawsnewid eich rhestrau cwympo safonol yn offer deinamig, aml-ddethol. Gyda'r sgiliau hyn, rydych chi bellach yn barod i greu dogfennau Excel mwy deinamig a hawdd eu defnyddio. I'r rhai sy'n awyddus i ymchwilio'n ddyfnach i alluoedd Excel, mae ein gwefan yn cynnwys cyfoeth o sesiynau tiwtorial. Darganfyddwch fwy o awgrymiadau a thriciau Excel yma.

Erthyglau Perthnasol