Página 1 de 1

Macro Ordenação de valores em linha

Enviado: 19 Jun 2017 às 16:12
por ruymds
Olá pessoal,

possuo uma macro (anexa) para ordenar uma quantidade de valores (menor para o maior) porém gostaria que a mesma fizesse a ordenação também por ordem de sequência...

exemplo:

Original
1 2 3 5 7 11 12 13 16 17 18 19 22 23 24
1 3 4 7 9 11 12 13 14 16 17 18 19 22 23
1 3 4 5 7 11 12 13 14 16 17 19 22 23 24
1 3 4 5 9 10 11 12 16 17 19 20 21 23 24
1 2 3 5 7 10 11 12 16 17 18 19 22 23 24
1 3 4 5 9 11 12 13 14 16 17 18 21 23 24

Ordenada
1 2 3 5 7 10 11 12 16 17 18 19 22 23 24
1 2 3 5 7 11 12 13 16 17 18 19 22 23 24
1 3 4 5 7 11 12 13 14 16 17 19 22 23 24
1 3 4 5 9 10 11 12 16 17 19 20 21 23 24
1 3 4 5 9 11 12 13 14 16 17 18 21 23 24
1 3 4 7 9 11 12 13 14 16 17 18 19 22 23

Grato.

Re: Macro Ordenação de valores em linha

Enviado: 19 Jun 2017 às 20:51
por osvaldomp
Código: Selecionar todos
Sub OrdenaLinhasV3()
 Dim k As Long, LR As Long
  Application.ScreenUpdating = False
  LR = Cells(Rows.Count, 1).End(3).Row
  For k = 1 To LR
   Cells(k, 1).Resize(, 15).Sort Key1:=Cells(k, 1), Order1:=xlAscending, Orientation:=xlLeftToRight
  Next k

  With ActiveWorkbook.ActiveSheet.Sort
   .SortFields.Clear
   .SortFields.Add Key:=Range("A1:A" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("B1:B" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("C1:C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("D1:D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("E1:E" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("F1:F" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("G1:G" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("H1:H" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("I1:I" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("J1:J" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("K1:K" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("L1:L" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("M1:M" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("N1:N" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SortFields.Add Key:=Range("O1:O" & LR), SortOn:=xlSortOnValues, Order:=xlAscending
   .SetRange Range("A1:O" & LR)
   .Header = xlNo
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
  End With
 Application.ScreenUpdating = True
End Sub