删除重复项并创建唯一列表

时间:2020-08-26 15:50:47

标签: excel vba

水果包含列表-苹果,香蕉,橙 和 颜色包含列表-红色,黑色,橙色

因此,当我从单元格“ G1” 的下拉列表中选择水果颜色时,然后“ Offset(0,-1)” 表示“ F1” 向我显示合并输出列表--(苹果,香蕉,橙色 ,红色,黑色,橙色)。 因此,单元格“ F1” 中的列表包含重复值 Orange ,并打印两次。 它应仅从选定的项目中选择唯一的项目,然后删除重复的项目,并应在单元格 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

1 个答案:

答案 0 :(得分:0)

此代码是否适合从输出数组中删除重复项并为我提供唯一值。

f = [ 1, 3, 2, 3, 7, 5, 2]
for i in range(0, len(f-1)):
    for j in range(0, len(f-2)):
        ...