Usuário com melhor resposta
Ordenar array no VB6

Pergunta
-
Respostas
-
Obrigado! Essa era a minha duvida, já havia encontrado algumas funções na internet referente ao comando, mas gostaria de saber se não existia uma função nativa. Caso sejá interessante segue abaixo uma soluçao para array bidimensional
Public Sub SortArray(ByRef DArray(), Element As Integer)
Dim gap As Integer, doneflag As Integer, SwapArray()
Dim Index As Integer
ReDim SwapArray(2, UBound(DArray, 1), UBound(DArray, 2))
'Gap is half the records
gap = Int(UBound(DArray, 2) / 2)
Do While gap >= 1
Do
doneflag = 1
For Index = 0 To (UBound(DArray, 2) - (gap + 1))
'Compare 1st 1/2 to 2nd 1/2
If DArray(Element, Index) > DArray(Element, (Index + gap)) Then
For acol = 0 To (UBound(SwapArray, 2) - 1)
'Swap Values if 1st > 2nd
SwapArray(0, acol, Index) = DArray(acol, Index)
SwapArray(1, acol, Index) = DArray(acol, Index + gap)
Next
For acol = 0 To (UBound(SwapArray, 2) - 1)
'Swap Values if 1st > 2nd
DArray(acol, Index) = SwapArray(1, acol, Index)
DArray(acol, Index + gap) = SwapArray(0, acol, Index)
Next
CNT = CNT + 1
doneflag = 0
End If
Next
Loop Until doneflag = 1
gap = Int(gap / 2)
Loop
End Sub- Marcado como Resposta jovir quinta-feira, 9 de maio de 2013 12:50
Todas as Respostas
-
Jovir,
Apesar de eu nunca ter trabalhado com Vb6 espero que estes links sejam uteis para você:
http://visualbasic.freetutes.com/learn-vb6/sorting-using-arrays.html
http://www.vbforums.com/showthread.php?473677-VB6-Sorting-algorithms-(sort-array-sorting-arrays)
Vitor Mendes | Seu feedback é muito importante para todos!
Visite o meu site: http://www.vitormendes.com.br/ -
Essa questao foi respondida aqui:
Evite postar a mesma pergunta em dois foruns diferentes... isso nao vai acelerar o tempo de resposta.
William John Adam Trindade
Analyste-programmeur
----------------------------------------------------------
Sogi informatique ltée -
Obrigado! Essa era a minha duvida, já havia encontrado algumas funções na internet referente ao comando, mas gostaria de saber se não existia uma função nativa. Caso sejá interessante segue abaixo uma soluçao para array bidimensional
Public Sub SortArray(ByRef DArray(), Element As Integer)
Dim gap As Integer, doneflag As Integer, SwapArray()
Dim Index As Integer
ReDim SwapArray(2, UBound(DArray, 1), UBound(DArray, 2))
'Gap is half the records
gap = Int(UBound(DArray, 2) / 2)
Do While gap >= 1
Do
doneflag = 1
For Index = 0 To (UBound(DArray, 2) - (gap + 1))
'Compare 1st 1/2 to 2nd 1/2
If DArray(Element, Index) > DArray(Element, (Index + gap)) Then
For acol = 0 To (UBound(SwapArray, 2) - 1)
'Swap Values if 1st > 2nd
SwapArray(0, acol, Index) = DArray(acol, Index)
SwapArray(1, acol, Index) = DArray(acol, Index + gap)
Next
For acol = 0 To (UBound(SwapArray, 2) - 1)
'Swap Values if 1st > 2nd
DArray(acol, Index) = SwapArray(1, acol, Index)
DArray(acol, Index + gap) = SwapArray(0, acol, Index)
Next
CNT = CNT + 1
doneflag = 0
End If
Next
Loop Until doneflag = 1
gap = Int(gap / 2)
Loop
End Sub- Marcado como Resposta jovir quinta-feira, 9 de maio de 2013 12:50