none
MÉTODO DE ORDENAÇÃO? RRS feed

 > 

  • Pergunta

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    ESTE MÉTODO ESTÁ DEMORANDO MUITO.

    ALGUÉM TEM ALGUM CÓDIGO MAIS EFICIENTE?

            INI = 2
        FIM = SHLIST1.UsedRange.Rows.Count
        For I = INI To FIM - 1
            For J = I + 1 To FIM
                If SHLIST1.Cells(I, 1) > SHLIST1.Cells(J, 1) Then
                    MENOR = SHLIST1.Cells(J, 1)
                    MENOR1 = SHLIST1.Cells(J, 2)
                    MENOR2 = SHLIST1.Cells(J, 3)
                    MENOR3 = SHLIST1.Cells(J, 4)
                    MENOR4 = SHLIST1.Cells(J, 5)
                    SHLIST1.Cells(J, 1) = SHLIST1.Cells(I, 1)
                    SHLIST1.Cells(J, 2) = SHLIST1.Cells(I, 2)
                    SHLIST1.Cells(J, 3) = SHLIST1.Cells(I, 3)
                    SHLIST1.Cells(J, 4) = SHLIST1.Cells(I, 4)
                    SHLIST1.Cells(J, 5) = SHLIST1.Cells(I, 5)
                    SHLIST1.Cells(I, 1) = MENOR
                    SHLIST1.Cells(I, 2) = MENOR1
                    SHLIST1.Cells(I, 3) = MENOR2
                    SHLIST1.Cells(I, 4) = MENOR3
                    SHLIST1.Cells(I, 5) = MENOR4
                End If
            Next J
        Next I

    sexta-feira, 5 de junho de 2015 16:56
    |

Respostas

  • Question
    Entrar para Votar
    0
    Entrar para Votar

    Sub ORDENAR()

     INTER = Replace(Sheets("LST1").UsedRange.Address, "$A$1", "$A$2")

    Sheets("LST1").Select
        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        ActiveWorkbook.Worksheets("LST1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("LST1").Sort.SortFields.Add Key:=Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
           
      
        With ActiveWorkbook.Worksheets("LST1").Sort
            .SetRange Range(INTER)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End Sub



    sexta-feira, 5 de junho de 2015 18:09
    |