Dropdown do Excel "Smart" / Validação de dados

Question

No Excel, existe uma maneira de criar um menu suspenso ou campo de validação de dados que

• Permite que o usuário insira um valor que não está atualmente na lista (como uma caixa de combinação)
• Salve esse valor na lista suspensa, para que, na próxima vez que o usuário acessar essa lista em um novo campo, o novo valor digitado seja exibido na lista suspensa
• Remover entradas duplicadas da lista suspensa (ou seja, se o usuário tiver inserido o vale "Apple" várias vezes na coluna, ele aparecerá apenas uma vez na lista suspensa)
• (opcional) Classifique o menu suspenso em ordem alfabética

A primeira coisa que tentei foi aplicar a validação de dados a uma coluna, configurando-a para listar e definindo a fonte da lista para a mesma coluna. Isso consegue atingir os dois primeiros pontos, mas infelizmente, dessa forma, cada valor é duplicado toda vez que é usado na coluna (e também não é ordenado na lista).

Qualquer ajuda é apreciada!

    

Answer 1

O código abaixo gera uma lista de combinação (validação de dados) e:

• Permite que os usuários insiram um valor que não está atualmente na lista
• Adiciona todos os novos valores à lista suspensa
• Remove entradas duplicadas
• Recorta todos os valores da lista
• Classifica a lista em ordem alfabética

Onde colar o código:

• Abra o editor de VBA: Alt + F11

  1. o primeiro sub Worksheet_Change() deve ser inserido no módulo VBA da planilha

• Todos os outros subs e funções (seções 1 e 2) devem ser colados em um novo módulo VBA

  2. no editor, clique no menu Inserir > Módulo e cole o novo código

.

No módulo Sheet1 (objetos do Microsoft Excel, no canto superior esquerdo do editor do VBA):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Columns.Count = 1 Then setList Target
End Sub

.

1 de 2 (novo módulo VBA):

Option Explicit

Public Sub setList(ByRef rng As Range, Optional fullColumn As Boolean = True)
   Dim ws As Worksheet, lst As Range, lr As Long

   If rng.Columns.Count = 1 Then
      xlEnabled False
      Set ws = rng.Parent
      Set lst = ws.UsedRange.Columns(rng.Column)
      lr = setLastRow(lst, rng.Column)
      If lr > 1 Then
         If fullColumn Then Set lst = ws.Columns(rng.Column)
         With lst.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=getDistinct(lst, lr)
            .ShowError = False
         End With
      End If
      xlEnabled True
   End If
End Sub

Private Function setLastRow(ByRef rng As Range, ByVal lc As Long) As Long
   Dim ws As Worksheet, lr As Long
   If Not rng Is Nothing Then
      Set ws = rng.Parent
      lr = ws.Cells(rng.Row + ws.UsedRange.Rows.Count + 1, lc).End(xlUp).Row
      Set rng = ws.Range(ws.Cells(1, lc), ws.Cells(lr, lc)) 'updates rng (ByRef)
   End If
   setLastRow = lr
End Function

Public Sub xlEnabled(ByVal onOff As Boolean)
    Application.ScreenUpdating = onOff
    Application.EnableEvents = onOff
End Sub

2 de 2 :

Private Function getDistinct(ByRef rng As Range, ByVal lr As Long) As String
   Dim ws As Worksheet, lst As String, lc As Long, tmp As Range

   Set ws = rng.Parent
   lc = ws.Cells(rng.Row, rng.Column + ws.UsedRange.Columns.Count + 1).End(xlToLeft).Column
   Set tmp = ws.Range(ws.Cells(1, lc + 1), ws.Cells(lr, lc + 1))

   If tmp.Count > 1 Then
      With tmp.Cells(1, 1)
         .Formula = "=Trim(" & ws.Cells(rng.Row, lc).Address(False, False) & ")"
         .AutoFill Destination:=tmp
      End With

      tmp.Value2 = tmp.Value2
      tmp.RemoveDuplicates Columns:=1, Header:=xlNo
      lr = setLastRow(tmp, lc + 1)

      ws.Sort.SortFields.Add Key:=ws.Cells(lr + 1, lc + 1), Order:=xlAscending
      With ws.Sort
         .SetRange tmp
         .Header = xlNo
         .MatchCase = False
         .Orientation = xlTopToBottom
         .Apply
      End With

      setLastRow tmp, lc + 1
      lst = Join(Application.Transpose(tmp), ",")
      tmp.Cells(1, 1).EntireColumn.Delete
   End If

   getDistinct = lst

End Function

Sempre que você inserir um novo valor (em qualquer coluna)

• O código desativa ScreenUpdating e Eventos (temporariamente)
• Qualquer validação de dados anterior para a coluna atual será removida
• Ele determina a última coluna usada na planilha e a última célula com dados na coluna atual

• Ele verifica se o menu suspenso deve ser aplicado à coluna completa ou apenas às células com dados

  • Esta opção pode ser alterada alterando fullColumn As Boolean = True para False

• Função getDistinct ():

  • copia todos os valores da coluna atual para a primeira coluna não utilizada na planilha
  • esta não é uma cópia normal \ colar operação
  • aplica o TRIM () na nova coluna para todas as células no col atual
  • transforma os resultados da fórmula em strings
  • aplica RemoveDuplicates somente a esse novo intervalo
  • aplica a classificação à lista restante
  • determina o tamanho da lista novamente e converte o intervalo em uma sequência de itens separados por vírgulas

• Sub setList () aplica a lista a uma nova regra de validação que gera o drop-down

  • Essa regra de validação pode ser excluída dos dados > Validação de dados (selecione a coluna e Limpar tudo)

• Pode ser desativado ao comentar uma linha:

.

Private Sub Worksheet_Change(ByVal Target As Range)
   'If Target.Columns.Count = 1 Then setList Target
End Sub