Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Criar uma régua de ...
 
Notifications
Clear all

Criar uma régua de matrícula e colocar os pontos respectivos

 
2024 - VBA & Macros
Post Recente por MPrudencio 6 anos atrás
8 Posts
3 Usuários
0 Reactions
1,812 Visualizações
RSS
 RAMZERO
(@ramzero)
Posts: 127
Estimable Member
Topic starter
 

Fala pessoal, boa noite!

Baseado no exemplo anexo, preciso criar uma régua de números (matrícula) em ordem decrescente e colocar as quantidades respectivas (pontos) a cada matrícula

Cada aluno tem um número de matrícula, exemplo: O aluno José é o 1, o João é o 2, etc.... O nome não importa

Chegam pra mim sem ordem numérica o número da matrícula e a pontuação do aluno numa lista em papel toda desorganizada

Gostaria de poder digitar numa célula (F2) o número da matrícula e numa outra célula ao lado (G2) sua pontuação correspondente

Então automaticamente o Excel:

1 - Ou insere na coluna A em ordem decrescente a matrícula (F2) se ela não existir ainda na coluna A. E na coluna B coloca o valor que digitei em G2, na linha correspondente dessa matrícula

2 - Ou, se já existir, procura uma matrícula igual na coluna A, ao que eu digitar em F2. E se na coluna B, já tiver um valor, então soma o que já tinha com o novo inserido, na linha correspondente dessa matrícula

3 - Pode haver casos que eu só digite a matrícula, então apenas insere na coluna A em ordem decrescente a matrícula (F2) se ela não existir ainda na coluna A

Alguém pode me ajudar?

Obrigado

 
Postado : 27/06/2018 6:03 pm
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Para funcionar, selecione a célula G3.

 
Postado : 27/06/2018 6:27 pm
 RAMZERO
(@ramzero)
Posts: 127
Estimable Member
Topic starter
 

Fala klarc28

Isso mesmo cara! Valeu mais uma vez

Só mais uma coisa

Usei aquela sua dica de gravar macro, para classificar as colunas A e B de forma decrescente com a coluna A como referência

Funcionou, só que o código dessa macro ficou muito estranho, bagunçado

Como faço pra deixar ele mais "enxuto", mais apresentável

Tem como me dar uma dica ou explicação de como lapidar esses códigos criados por gravação de macro?

Obrigado

 
Postado : 28/06/2018 4:43 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 
Sub Macro1()
Dim linha As Long
    
    
    linha = 2
    While Plan1.Range("A" & linha).Value <> ""
        
        
        linha = linha + 1
        
    Wend
linha = linha - 1
plan1.select
    plan1.Range("A2:B" & linha).Select
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("A2:B" & linha)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("F2").Select
End Sub
 
Postado : 28/06/2018 5:58 am
 RAMZERO
(@ramzero)
Posts: 127
Estimable Member
Topic starter
 

Essa parte que eu queria aprender a deixar mais enxuta e apresentável:

With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("A2:B" & linha)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With

Tipo assim:

Range("A2:B" & linha).Orientation = xlTopToBottom

Sei que essa linha acima não funciona, mas foi só um exemplo do que me refiro a deixar o código mais apresentável

Obrigado

 
Postado : 28/06/2018 11:56 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Creio que seria repetitivo, pois ficaria assim:

        ActiveWorkbook.Worksheets("Plan1").Sort.SetRange Range("A2:B" & linha)
        ActiveWorkbook.Worksheets("Plan1").Sort.Header = xlNo
        ActiveWorkbook.Worksheets("Plan1").Sort.MatchCase = False
        ActiveWorkbook.Worksheets("Plan1").Sort.Orientation = xlTopToBottom
        ActiveWorkbook.Worksheets("Plan1").Sort.SortMethod = xlPinYin
        ActiveWorkbook.Worksheets("Plan1").Sort.Apply
 
Postado : 28/06/2018 11:59 am
 RAMZERO
(@ramzero)
Posts: 127
Estimable Member
Topic starter
 

A tá, achei que dava pra fazer tipo assim, exemplo:

ActiveWorkbook.Worksheets("Plan1").Sort.SetRange Range("A2:B" & linha).Header = xlNo.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlPinYin.Apply

Ou

ActiveWorkbook.Worksheets("Plan1").SetRange Range("A2:B" & linha).Header = xlNo.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlPinYin.Apply

Valeu klarc28

 
Postado : 28/06/2018 12:22 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Pode fazer assim:


Sub classificar()

Dim linha as long

linha = plan1.range("A" & rows.count).end(xlup).row

Plan1.Range("A2:B" & linha).Sort Plan1.Range("A2"), xlAscending

End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 30/06/2018 11:43 am
Forum Jump:
  Tópico Anterior
Próximo Tópico