Как удалить дубликаты из массивов
Цитата:Фрукты содержат список - яблоко,банан,апельсин, а цвета содержат список - красный,черный,оранжевый
поэтому, когда я мульти выбираю фрукты, а также цвета из выпадающего списка из ячейки "G1". Затем "смещение(0, -1)" означает, что "F1" показывает мне список выходных данных комбайна как - (яблоко, банан, апельсин, красный, черный, оранжевый). Итак, список в ячейке "F1" содержит дубликат значения Orange и печатается 2 раза. Он должен забрать только уникальные предметы из выбранного и удалить дубликат, а также напечатать в ячейке F1 как - (яблоко, банан, оранжевый, красный, черный).
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim rngDV As Range, oldVal As String, newVal As String Dim arr As Variant, El As Variant If Target.count > 1 Then GoTo exitHandler If Target.value = "" Then Application.EnableEvents = False Target.Offset(0, -1).value = "" Application.EnableEvents = True Exit Sub End If On Error Resume Next Set rngDV = cells.SpecialCells(xlCellTypeAllValidation) On Error GoTo exitHandler If rngDV Is Nothing Then GoTo exitHandler If Not Intersect(Target, rngDV) Is Nothing Then Application.EnableEvents = False newVal = Target.value: Application.Undo oldVal = Target.value: Target.value = newVal If Target.Column = 7 Then If oldVal <> "" Then If newVal <> "" Then arr = Split(oldVal, ",") For Each El In arr If El = newVal Then Target.value = oldVal GoTo exitHandler End If Next Target.value = oldVal & "," & newVal Target.EntireColumn.AutoFit End If End If End If writeSeparatedStringLast Target End If exitHandler: Application.EnableEvents = True End Sub Sub writeSeparatedStringLast(rng As Range) Dim arr As Variant, arrFin As Variant, El As Variant, k As Long, listBox As MSForms.listBox Dim arrFr As Variant, arrVeg As Variant, arrAnim As Variant, El1 As Variant Dim strFin As String ', rng2 as range arrFr = Split("Apple,Banana,Orange", ",") arrVeg = Split("Onion,Tomato,Cucumber", ",") arrAnim = Split("Red,Black,Orange", ",") arr = Split(rng.value, ",") For Each El In arr Select Case El Case "Fruits" arrFin = arrFr Case "Vegetables" arrFin = arrVeg Case "Colors" arrFin = arrAnim End Select For Each El1 In arrFin strFin = strFin & El1 & ", " Next Next strFin = left(strFin, Len(strFin) - 1) With rng.Offset(0, -1) .value = strFin .WrapText = True .Select End With End Sub 'Firstly run the next Sub, in order to create a list validation in range "G1": Sub CreateValidationBis() Dim sh As Worksheet, rng As Range Set sh = ActiveSheet Set rng = sh.Range("G1") With rng.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:="Fruits,Vegetables,Colors" .IgnoreBlank = True .InCellDropdown = True .ShowInput = True .ShowError = True End With End Sub
Что я уже пробовал:
Я пробовал разные коды для удаления дубликатов из массива, но не смог получить подходящий код для удаления дубликатов, который может подойти к моему коду и соответствовать моему условию.
0x01AA
Итак, вы считаете, что здесь можно сравнить "расщепленный олдвал" с "нерасщепленным ньювалом" If El = newVal Then
?