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
#36413
Bom dia, pessoal

Escrevi um código que insere o registro mais recente sempre no topo de uma tabela (TB_Pacientes) e busca sempre o maior número de registro na coluna cadastro, acrescido de +1, para inserir o novo registro com esse número .
Feito isso o código executa a rotina descrita abaixo que foi feita com a ajuda do gravador de macros.

Parte do código:
Código: Selecionar todos
tabela.Sort. _
        SortFields.Clear
    tabela.Sort. _
        SortFields.Add Key:=Range("TB_Pacientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("TB_Pacientes[Cadastro]").FormulaR1C1 = _
        "=LIN()-LIN(TB_Pacientes[[#Cabeçalhos],[Cadastro]])"
    Range("TB_Pacientes[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_Pacientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("TB_Pacientes[Nome]").Select
    tabela.Sort.SortFields.Clear
    tabela.Sort. _
        SortFields.Add Key:=Range("TB_Pacientes[[#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
Basicamente o que ele faz é apagar os valores da coluna de cadastros, colocar em ordem ascendente (menor para o maior) os registros da tabela conforme a data, renumerar os registros usando a fórmula =LIN()-LIN(valor da linha anterior), organizar novamente em forma descendente (conforme a data de registro) e no final organizar em ordem alfabética de A-Z.

Tudo isso para que os registros mais recentes fiquem no topo da tabela e recebam número de cadastro de forma crescente e ao final organize o nome dos pacientes na sequencia alfabética.

Enfim... o código apresenta muitas repetições de comando (como disse foi realizado com o gravador de macros). Há como resumir ou há uma maneira melhor de fazer essa rotina:
- Registros mais recentes recebem números maiores e devem ficar no topo da tabela.

Obrigado e tenham um bom dia.
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