Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
VBA Ordem Crescente...
 
Notifications
Clear all

VBA Ordem Crescente Excel 2003

 
2024 - VBA & Macros
14 Posts
2 Usuários
0 Reactions
3,169 Visualizações
RSS
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Foristas, boa noite!!!
Acompanho este fórum a algum tempo, e com a prontidão e ajuda de vocês já conseguir sanar muitas dúvidas, obrigado a todos!!
Criei um código Preliminar para classificação em Ordem Crescente no Excel 2007, mas para funcionar corretamente no Excel 2003, tive que realizar mudanças.
Ao mudar o código, a classificação está ocorrendo de forma Crescente, mas classificando e inserindo os dados para o final da tabela. Por favor gostaria que a classificação e inserção de dados ficasse disposta do inicio para o fim da tabela, podem me ajudar. Agradeço! Miranda
CÓDIGO:

Range("E4:E34").Select
Selection.Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("f4:g34").Select
Selection.Sort Key1:=Range("f4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("h4:i34").Select
Selection.Sort Key1:=Range("h4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("j4:j34").Select
Selection.Sort Key1:=Range("j4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Selection.Sort Key1:=Range("j4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("k4:k34").Select
Selection.Sort Key1:=Range("k4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("l4:l34").Select
Selection.Sort Key1:=Range("l4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Range("m4:m34").Select
Selection.Sort Key1:=Range("m4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-6
Columns("F:F").Select
Selection.EntireColumn.Hidden = True
Columns("H:H").Select
Selection.EntireColumn.Hidden = True
Range("C15").Select
Cells.Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Abraços

 
Postado : 27/01/2014 3:48 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

É só inverter a ordem que vc está aplicando o sort...
e mais, vc vai ver que eu eliminei algumas linhas q eu acho desnecessárias, não se preocupe ok?

Range("m4:m34").Sort Key1:=Range("m4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("l4:l34").Sort Key1:=Range("l4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("k4:k34").Sort Key1:=Range("k4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("j4:j34").Sort Key1:=Range("j4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("h4:i34").Sort Key1:=Range("h4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("f4:g34").Sort Key1:=Range("f4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("E4:E34").Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal


Columns("F:F").EntireColumn.Hidden = True
Columns("H:H").EntireColumn.Hidden = True
Range("C15").Select
Cells.Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Postado : 27/01/2014 3:56 pm
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Fernando, obrigado por sua ajuda!!!
Quanto a ordem crescente, funcionou corretamente. Mas a inserção dos dados ficou de baixo para cima, deixando espaço vago na parte superior da tabela, a qual necessitaria de ser preenchida e deixar os espaços vazios na parte de baixo da tabela. O que pode ser? Este é o código completo, com a modificação realizada por você:
Range("C12").Select
ActiveSheet.Unprotect
Columns("E:I").Select
Selection.EntireColumn.Hidden = False
Range("E4:M34").Select
Selection.ClearContents
Range("C21").Select
Sheets("ESCALA").Select
Sheets("ESCALA AUTOMATICA (2)").Visible = True
ActiveSheet.Unprotect
Range("BH48:BS48").Select
Selection.Copy
Sheets("ESCALA").Select
Range("E2:M2").Select
Selection.ClearContents
Sheets("ESCALA AUTOMATICA (2)").Select
Cells.Select
Range("BF44").Activate
ActiveSheet.Unprotect
Range("BH48:BS48").Select
Selection.Copy
Sheets("ESCALA").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O12").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("C19").Select
Sheets("ESCALA AUTOMATICA (2)").Select
ActiveWindow.SmallScroll Down:=3
Range("BH51:BL81,BP51:BS81").Select
Range("BP51").Activate
Application.CutCopyMode = False
Selection.Copy
Range("BS58").Select
Sheets("ESCALA").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ESCALA AUTOMATICA (2)").Select
ActiveWindow.SmallScroll Down:=-6
Cells.Select
Range("BF44").Activate
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("ESCALA AUTOMATICA (2)").Select
ActiveWindow.SelectedSheets.Visible = False
Range("m4:m34").Sort Key1:=Range("m4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("l4:l34").Sort Key1:=Range("l4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("k4:k34").Sort Key1:=Range("k4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("j4:j34").Sort Key1:=Range("j4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("h4:i34").Sort Key1:=Range("h4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("f4:g34").Sort Key1:=Range("f4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("E4:E34").Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Columns("F:F").EntireColumn.Hidden = True
Columns("H:H").EntireColumn.Hidden = True
Range("C15").Select
Cells.Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 
Postado : 27/01/2014 4:05 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Tem cabeçalhos na sua tabela ?

 
Postado : 28/01/2014 7:00 am
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Sim, teria campos de infomação sobre dias de folga e de trabalho, mas a classificação crescente teria como base a Coluna E.

 
Postado : 28/01/2014 9:46 am
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Refiz algumas alterações no código e não consegui fazê-lo funcionar corretamente no Excel 2003. Perdido... Ajuda por favor!!!

 
Postado : 28/01/2014 5:14 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Troque os xlguess por xlyes

e... Coloca um modelo da sua planilha com o código... Não esqueça de compactar!

 
Postado : 28/01/2014 5:19 pm
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Fernando, segui sua sugestão e deu certo somente com a 1ª linha da tabela, por favor, o que pode ser??

 
Postado : 28/01/2014 5:26 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Preciso ver seu arquivo

se for confidencial demais, me manda por email, mas adivinhar o problema sem ver a planilha, ja acabou minha cota de criatividade !

FF
[email protected]

 
Postado : 28/01/2014 5:36 pm
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Enviado. Obrigado!!

 
Postado : 28/01/2014 5:42 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

o problema é q em termos de classificação/ordenação, o excel considera que o traço vem antes dos numeros e letras... quando vc classifica em orderm crescente, os traços vem antes. (Vi que traços são as células que vc quer para entrar dados e tal, e vc as quer embaixo.

O jeoto mais fácil é classificar em ordem decrescente, ao invés de crescente.

UM DETALHE importante, desfaça a alteração que eu pedi. troque os xlguess (ou xlyes como vc trocou) por xlNo. isso pq no intervalo de linha 4 a linha 34 de todos os Range().Sort, não há cabeçalho, ou seja o cabeçalho está na linha 3... e nao faz parte dos intervalos propostos por você entendeu?

Esse pedaço pode ficar assim:

Range("l4:l34").Sort Key1:=Range("l4"), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("k4:k34").Sort Key1:=Range("k4"), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("j4:j34").Sort Key1:=Range("j4"), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("h4:i34").Sort Key1:=Range("h4"), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("f4:g34").Sort Key1:=Range("f4"), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Range("E4:E34").Sort Key1:=Range("E4"), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Eu tentei trocar o traço, encontrei as areas escondidas, óbvio, mas não achei um caracter bonitinho que na classificação, seja considerado posterior ao "z" . .

Entonces... acho que inverter a ordem das tabelas pode ser uma boa saída !

Testa e diz o que acha...

abs

 
Postado : 29/01/2014 1:36 pm
 Miranda
(@miranda)
Posts: 46
Trusted Member
Topic starter
 

Fernando, novamente, muito obrigado!!
Refiz como você sugeriu, usando a classificação decrescente, funcionou corretamente.
Finalizarei a tabela e posteriormente tentarei classificar separadamente por coluna ou refazer a tabela.
Obrigado pelo esforço e consideração. Abçs!!

 
Postado : 29/01/2014 3:43 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Marquei o tópico como resolvido entao.
se precisar de mais ajuda, crie um novo e referencie este.

q bom q deu certo! :)

 
Postado : 29/01/2014 3:50 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Caso seja necessário reabrir o tópico, o autor poderá enviar uma MP para um dos moderadores solicitando o desbloqueio.

 
Postado : 29/01/2014 7:34 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico