(آموزشی) استفاده از منوی آبشاری با امکان انتخاب چند گانه و حذف همزمان

[rasools13]

سلام
عنوان : نحوه انتخاب چند گزینه همزمان و حذف کردن گزینه ها از منوی آبشاری
راه حل:
بر روی نام شیتی منوی آبشاری در ان قرار دارد کلیک راست کرده و viewCode را انتخاب کنید و کد ذیل را در کادر باز شده کپی نمایید

Private Sub Worksheet_Change(ByVal Target As Range)

Dim oldVal As String
Dim newVal As String
Dim strSep As String
Dim strType As Long
Dim AA As String
Dim HasVal As Boolean
Dim newValLen, newValPos As Double

'اضافه کردن ، بين گزينه ها
strSep = ", "
    AA = Target.Address
    If AA = "$C$4" Then   'آدرس سلولهايي که داراي منوي آبشاري هستند رو به اين قسمت اضافه کنيد
        If Target.Count > 1 Then GoTo exitHandler
        
        On Error Resume Next
        strType = Target.Validation.Type
        
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        If newVal <> "" Then
            HasVal = Application.WorksheetFunction.IsNumber(Application.WorksheetFunction.Search(newVal, oldVal))
        Else
            HasVal = False
        End If
        If HasVal = True Then
            newValLen = Len(newVal)
            newValPos = Application.WorksheetFunction.Find(newVal, oldVal)
            If newValPos > 1 Then
                Target.Value = Application.WorksheetFunction.Replace(oldVal, newValPos - 2, newValLen + 2, "")
            Else
                Target.Value = Application.WorksheetFunction.Replace(oldVal, newValPos, newValLen + 2, "")
            End If
        Else
            If oldVal = "" Or newVal = "" Then
              Target.Value = newVal
            Else
              Target.Value = oldVal _
                & strSep & newVal
            End If
        End If
    End If

exitHandler:
    Application.EnableEvents = True
End Sub 

در قسمتی که در کد نیز مشخص شده است ادرس سلول یا سلوهایی که دارای منوی آبشاریی هست را مشخص کنید
حال با انتخاب هر گزینه از منوی آبشاری گزینه انتخابی به لیست اضافه شده و بانتخاب مجدد ان از موارد انتخاب شده حذف خواهد شد.

امیدوارم به کارتون بیاد