Bhushan Agrawal JSR Ответов: 1

Как удалить дубликаты из массивов


Цитата:
Фрукты содержат список - яблоко,банан,апельсин, а цвета содержат список - красный,черный,оранжевый

поэтому, когда я мульти выбираю фрукты, а также цвета из выпадающего списка из ячейки "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?

1 Ответов

Рейтинг:
2

Bhushan Agrawal JSR

Public Function RemoveDuplicateWords(InputString As String) As String
    Dim InputArray() As String
    InputArray = Split(InputString, " ")

    Dim DictUnique As Object
    Set DictUnique = CreateObject("Scripting.Dictionary")

    Dim OutputString As String

    Dim Word As Variant
    For Each Word In InputArray
        If Not DictUnique.Exists(Word) Then
            DictUnique.Add Word, 1
            OutputString = OutputString & " " & Word
        End If 
    Next Word
    RemoveDuplicateWords = Trim$(OutputString)
End Function



Цитата:
Является ли этот код для удаления дубликата будет работать для моего кода


CHill60

Является ли это решением вашей собственной проблемы или это дополнительная информация о вашем вопросе?

Bhushan Agrawal JSR

Вопрос в том, удалит ли этот код дубликаты из моего списка массивов?

Bhushan Agrawal JSR

Является ли этот второй код правильным ? удалит ли он дубликат из моего кода ?

CHill60

Публикуя решение, вы удаляете свое сообщение из списка вопросов без ответа. Используйте ссылку "улучшить вопрос", чтобы добавить информацию и удалить это не решение