0

Tenho uma lista padrão com valores e outra lista de "Organização" quando deleto valores da lista padrão a outra lista de organização, organiza os valores. O problema é que eu adicionei uma caixa de combinação com o intervalo da lista de organização, eu queria que a caixa não exibisse os espaços em branco e exibisse apenas os valores que correspondem a lista de organização, como não exibir os espaços em branco da caixa de combinação?? inserir a descrição da imagem aqui

0

1 Resposta 1

1

Problema

Ao preencher a lista de combinação pela propriedade ListFillRange, este erro ocorrerá.

ListFillRange

Solução

Então o código a seguir pode ser utilizado para remover duplicatas, remover células vazias e ordenar (caso deseje ordenar, leia a seção SortDictionary) os itens na sua Caixa de Combinação.

Código

Sub preencher_lista()
    Dim intervalo_lista As Variant
    Dim unico As Object, u, k
    Dim i As Long
    Dim tmp As String

    Set unico = CreateObject("scripting.dictionary")

    'Objeto OLE de nome ComboBox1, este pode ser visto no parâmetro (Name) em propriedades
    ComboBox1.Clear
    'Nome da planilha utilizada
    With Sheets("Planilha1")
        'Intervalo da lista, inicia em A2 e termina na última célula preenchida
        intervalo_lista = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
        'Único elemento
        For Each c In intervalo_lista
            tmp = Trim(c)
            'Verifica se é maior do que 0 (não vazio), se sim, adiciona ao dicionário para obter valores únicos
            If Len(tmp) > 0 Then unico(tmp) = unico(tmp) + 1
        Next c
        'Função de ordenação do dicionário
        'http://www.cpearson.com/excel/CollectionsAndDictionaries.htm
        'Descomente a linha abaixo se desejar a ordenação
        'SortDictionary unico, True

        'Adiciona na lista de combinação
        For Each k In unico.Keys
            ComboBox1.AddItem k
        Next k
    End With
End Sub

Resultado

Resultado

SortDictionary

Para utilizar a ordenação de dicionário SortDictionary do CPearson, a referência "Microsoft Scripting Runtime" deve ser adicionada em "Ferramentas -> Referências..."

Isso é necessário pois so Early Binding é utilizado nestas funções de dicionário.

Microsoft Scripting Runtime

O seguinte código deve ser adicionados em um módulo de funções auxiliares:

Public Sub SortDictionary(Dict As Scripting.Dictionary, _
    SortByKey As Boolean, _
    Optional Descending As Boolean = False, _
    Optional CompareMode As VbCompareMethod = vbTextCompare)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SortDictionary
' This sorts a Dictionary object. If SortByKey is False, the
' the sort is done based on the Items of the Dictionary, and
' these items must be simple data types. They may not be
' Object, Arrays, or User-Defined Types. If SortByKey is True,
' the Dictionary is sorted by Key value, and the Items in the
' Dictionary may be Object as well as simple variables.
'
' If sort by key is True, all element of the Dictionary
' must have a non-blank Key value. If Key is vbNullString
' the procedure will terminate.
'
' By defualt, sorting is done in Ascending order. You can
' sort by Descending order by setting the Descending parameter
' to True.
'
' By default, text comparisons are done case-INSENSITIVE (e.g.,
' "a" = "A"). To use case-SENSITIVE comparisons (e.g., "a" <> "A")
' set CompareMode to vbBinaryCompare.
'
' Note: This procedure requires the
' QSortInPlace function, which is described and available for
' download at www.cpearson.com/excel/qsort.htm .
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Ndx As Long
Dim KeyValue As String
Dim ItemValue As Variant
Dim Arr() As Variant
Dim KeyArr() As String
Dim VTypes() As VbVarType


Dim V As Variant
Dim SplitArr As Variant

Dim TempDict As Scripting.Dictionary
'''''''''''''''''''''''''''''
' Ensure Dict is not Nothing.
'''''''''''''''''''''''''''''
If Dict Is Nothing Then
    Exit Sub
End If
''''''''''''''''''''''''''''
' If the number of elements
' in Dict is 0 or 1, no
' sorting is required.
''''''''''''''''''''''''''''
If (Dict.Count = 0) Or (Dict.Count = 1) Then
    Exit Sub
End If

''''''''''''''''''''''''''''
' Create a new TempDict.
''''''''''''''''''''''''''''
Set TempDict = New Scripting.Dictionary

If SortByKey = True Then
    ''''''''''''''''''''''''''''''''''''''''
    ' We're sorting by key. Redim the Arr
    ' to the number of elements in the
    ' Dict object, and load that array
    ' with the key names.
    ''''''''''''''''''''''''''''''''''''''''
    ReDim Arr(0 To Dict.Count - 1)

    For Ndx = 0 To Dict.Count - 1
        Arr(Ndx) = Dict.Keys(Ndx)
    Next Ndx

    ''''''''''''''''''''''''''''''''''''''
    ' Sort the key names.
    ''''''''''''''''''''''''''''''''''''''
    QSortInPlace InputArray:=Arr, LB:=-1, UB:=-1, Descending:=Descending, CompareMode:=CompareMode
    ''''''''''''''''''''''''''''''''''''''''''''
    ' Load TempDict. The key value come from
    ' our sorted array of keys Arr, and the
    ' Item comes from the original Dict object.
    ''''''''''''''''''''''''''''''''''''''''''''
    For Ndx = 0 To Dict.Count - 1
        KeyValue = Arr(Ndx)
        TempDict.Add Key:=KeyValue, Item:=Dict.Item(KeyValue)
    Next Ndx
    '''''''''''''''''''''''''''''''''
    ' Set the passed in Dict object
    ' to our TempDict object.
    '''''''''''''''''''''''''''''''''
    Set Dict = TempDict
    ''''''''''''''''''''''''''''''''
    ' This is the end of processing.
    ''''''''''''''''''''''''''''''''
Else
    '''''''''''''''''''''''''''''''''''''''''''''''
    ' Here, we're sorting by items. The Items must
    ' be simple data types. They may NOT be Objects,
    ' arrays, or UserDefineTypes.
    ' First, ReDim Arr and VTypes to the number
    ' of elements in the Dict object. Arr will
    ' hold a string containing
    '   Item & vbNullChar & Key
    ' This keeps the association between the
    ' item and its key.
    '''''''''''''''''''''''''''''''''''''''''''''''
    ReDim Arr(0 To Dict.Count - 1)
    ReDim VTypes(0 To Dict.Count - 1)

    For Ndx = 0 To Dict.Count - 1
        If (IsObject(Dict.Items(Ndx)) = True) Or _
            (IsArray(Dict.Items(Ndx)) = True) Or _
            VarType(Dict.Items(Ndx)) = vbUserDefinedType Then
            Debug.Print "***** ITEM IN DICTIONARY WAS OBJECT OR ARRAY OR UDT"
            Exit Sub
        End If
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Here, we create a string containing
        '       Item & vbNullChar & Key
        ' This preserves the associate between an item and its
        ' key. Store the VarType of the Item in the VTypes
        ' array. We'll use these values later to convert
        ' back to the proper data type for Item.
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            Arr(Ndx) = Dict.Items(Ndx) & vbNullChar & Dict.Keys(Ndx)
            VTypes(Ndx) = VarType(Dict.Items(Ndx))

    Next Ndx
    ''''''''''''''''''''''''''''''''''
    ' Sort the array that contains the
    ' items of the Dictionary along
    ' with their associated keys
    ''''''''''''''''''''''''''''''''''
    QSortInPlace InputArray:=Arr, LB:=-1, UB:=-1, Descending:=Descending, CompareMode:=vbTextCompare

    For Ndx = LBound(Arr) To UBound(Arr)
        '''''''''''''''''''''''''''''''''''''
        ' Loop trhogh the array of sorted
        ' Items, Split based on vbNullChar
        ' to get the Key from the element
        ' of the array Arr.
        SplitArr = Split(Arr(Ndx), vbNullChar)
        ''''''''''''''''''''''''''''''''''''''''''
        ' It may have been possible that item in
        ' the dictionary contains a vbNullChar.
        ' Therefore, use UBound to get the
        ' key value, which will necessarily
        ' be the last item of SplitArr.
        ' Then Redim Preserve SplitArr
        ' to UBound - 1 to get rid of the
        ' Key element, and use Join
        ' to reassemble to original value
        ' of the Item.
        '''''''''''''''''''''''''''''''''''''''''
        KeyValue = SplitArr(UBound(SplitArr))
        ReDim Preserve SplitArr(LBound(SplitArr) To UBound(SplitArr) - 1)
        ItemValue = Join(SplitArr, vbNullChar)
        '''''''''''''''''''''''''''''''''''''''
        ' Join will set ItemValue to a string
        ' regardless of what the original
        ' data type was. Test the VTypes(Ndx)
        ' value to convert ItemValue back to
        ' the proper data type.
        '''''''''''''''''''''''''''''''''''''''
        Select Case VTypes(Ndx)
            Case vbBoolean
                ItemValue = CBool(ItemValue)
            Case vbByte
                ItemValue = CByte(ItemValue)
            Case vbCurrency
                ItemValue = CCur(ItemValue)
            Case vbDate
                ItemValue = CDate(ItemValue)
            Case vbDecimal
                ItemValue = CDec(ItemValue)
            Case vbDouble
                ItemValue = CDbl(ItemValue)
            Case vbInteger
                ItemValue = CInt(ItemValue)
            Case vbLong
                ItemValue = CLng(ItemValue)
            Case vbSingle
                ItemValue = CSng(ItemValue)
            Case vbString
                ItemValue = CStr(ItemValue)
            Case Else
                ItemValue = ItemValue
        End Select
        ''''''''''''''''''''''''''''''''''''''
        ' Finally, add the Item and Key to
        ' our TempDict dictionary.

        TempDict.Add Key:=KeyValue, Item:=ItemValue
    Next Ndx
End If


'''''''''''''''''''''''''''''''''
' Set the passed in Dict object
' to our TempDict object.
'''''''''''''''''''''''''''''''''
Set Dict = TempDict
End Sub

E todas as funções do código de QSortInPlace na seção "The Code".

Observação: Não é possível inserir mais do que 30 mil caracteres na resposta, então não foi possível inserir o código inteiro. As funções são encontradas em SortingArrays do CPearson

7
  • Gerou um erro ao inciar o código. "Erro em tempo de execução '-2147467259 (80004005)': "Erro de automação" "Erro não especificado" 28/08/2019 às 18:12
  • Você está tentando ordenar? Em que linha? Clicou com o botão direito no Combobox e selecionou Exibir código? 28/08/2019 às 18:15
  • Teria um jeito de criar um simples código seguido de um botão, para apenas limpar os espaços vazios da ComboBox, ao pressionar o botão. Para isso teria que reduzir o intervalo no momento que o botão for pressionado e depois de algum jeito o intervalo aceitar mais conteúdos quando eu digitar adicionar valores na "list" 28/08/2019 às 18:16
  • Este é simples, a parte difícil está comentada . Que é a parte de SortDictionary. Insira o código na Planilha utilizada e não num módulo. Não esqueça de mudar o nome da planilha em Planilha1 28/08/2019 às 18:20
  • Sim mas a lista já está sendo ordenada no intervalo "Organization" eu fiz uma fórmula para ela organizar. Os valores são adicionados no intervalo "List" e são organizados na "Organization", logo a combobox organiza os resultados que sobraram. O problema é que ele está apresentando espaços vazios 28/08/2019 às 18:25

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .