Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por SandroLima
#37450
Boa noite, pessoal.

Tenho um código que utilizo no botão "OK" de um formulário de uma planilha e ao clicar ele funciona perfeitamente.

Basicamente, essa parte do código em questão, tem como ações (sempre nessa ordem):
1) ordena/filtra por data (recente para a mais antiga);
2) depois ele faz a numeração da coluna cadastro usando LIN()- LIN(célula acima);
3) ordena a coluna de cadastro do maior(topo da tabela) para o menor (última linha da tabela)
4) ordena de novo por data, da mais recente (topo da tabela) para a mais antiga (final da tabela)
5) e, por último, ordena a coluna de nomes em ordem alfabética.

Pensei em utilizar esse código no evento Initialize do formulário mas não funciona. Pensei em fazer isso pq alguns registros podem ser apagados manualmente na tabela e com isso seriam sempre reorganizados ao iniciar o formulário.
Código: Selecionar todos
Private Sub UserForm_Initialize()
    
    Me.Height = Int(0.9 * ActiveWindow.Height) 'Ajusta a altura do formulário
    Me.Width = Int(0.9 * ActiveWindow.Width)  'Ajusta a largura do formulário
    
    Dim Tabela As ListObjects
    Set Tabela = wshCadastro.ListObjects("TB_Clientes")
    
    Tabela.Sort. _
        SortFields.Clear
    Tabela.Sort. _
        SortFields.Add Key:=Range("TB_Clientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With Tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("TB_Clientes[Cadastro]").FormulaR1C1 = _
        "=LIN()-LIN(TB_Clientes[[#Cabeçalhos],[Cadastro]])"
    Range("TB_Clientes[Cadastro]").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Tabela.Sort. _
        SortFields.Clear
    Tabela.Sort. _
        SortFields.Add Key:=Range("TB_Clientes[[#All],[Cadastro]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With Tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Tabela.Sort. _
        SortFields.Clear
    Tabela.Sort. _
        SortFields.Add Key:=Range("TB_Clientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With Tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Tabela.Sort.SortFields.Clear
    Tabela.Sort. _
        SortFields.Add Key:=Range("TB_Clientes[[#All],[Nome]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With Tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Tabela.Sort.SortFields.Clear
    Tabela.ListRows(1).Range(1, 1).Select
    Application.CutCopyMode = False
    
    Set Tabela = Nothing
    
End Sub
Porém esse código não roda no evento Initialize do formulário.

Alguém poderia me ajudar em como proceder?

Como eu melhoria a escrita do código (fiz com a ajuda do gravador de macros e não sei se todas as linhas são necessárias).

Segue planilha para testes.

Obrigado e boa noite.
Você não está autorizado a ver ou baixar esse anexo.
Por babdallas
#37453
Veja se é o que deseja:
Código: Selecionar todos
Private Sub UserForm_Initialize()
    
    Me.Height = Int(0.9 * ActiveWindow.Height) 'Ajusta a altura do formulário
    Me.Width = Int(0.9 * ActiveWindow.Width)  'Ajusta a largura do formulário
    
    Dim Tabela As ListObject
    Set Tabela = wshCadastro.ListObjects("TB_Clientes")
    
    'Classifica os dados por data
    With Tabela.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("TB_Clientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'Insere um índice sequencial na coluna Cadastro e copia valores
    With Tabela.ListColumns("Cadastro").DataBodyRange
        .FormulaLocal = _
                        "=LIN()-LIN(TB_Clientes[[#Cabeçalhos];[Cadastro]])"
        .Value = .Value
    End With
    
    'Classifica os indices do maior para o menor
    With Tabela.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("TB_Clientes[[#All],[Cadastro]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    'Classifica as datas da mais recente para a mais antiga
    With Tabela.Sort
        .SortFields.Add Key:=Range("TB_Clientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'Classifica os NOmes em ordem ascendente
    With Tabela.Sort
        .SortFields.Add Key:=Range("TB_Clientes[[#All],[Nome]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Tabela.Sort.SortFields.Clear
    Tabela.ListRows(1).Range(1, 1).Select
    
    Set Tabela = Nothing
    
End Sub
Você não está autorizado a ver ou baixar esse anexo.
Por SandroLima
#37460
Bom dia, babdallas...

Funcionou. Acrescentei apenas uma linha de comando na última parte do código pq não estava colocando a coluna de Nomes na ordem.

Mas rodou certinho.

Muito obrigado.
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord