Mais uma do fórum, dessa vez, da autoria do colega André.
O código abaixo faz a ordenação de um array multidimensional, incrementando um exemplo já colocado aqui no blog que fazia o trabalho, mas somente com em arrays com uma dimensão. Bom, o código e seus comentários falam por si:
'@Sort ArrayMulti'@Data: 04/08/2010'@Autor: André Tonini' Esta função ordena um array multidimensional' Parametros' @TheArray - Array - Array que será ordenado' @Column - Integer - Por qual coluna o array será ordenado' @ColumnCount - Integer - O número de colunas do arrayPublicFunction SortArrayMulti(ByRef TheArray AsVariant, _
Column, _
ColumnCount)
'Variaveis'----------Dim temp()
Dim x, i, y AsIntegerDim sorted AsBoolean'Dimensões do array'------------------ReDimPreserve temp(1 ToUBound(TheArray, Column), 1 To ColumnCount)
'Repetição para ordenar até o final do array'--------------------------------------------DoWhileNot sorted
'No inicio ele está ordenado'--------------------------
sorted = True'Laço que percorre as linhas'----------------------------For x = linhaCabecalho + 1 ToUBound(TheArray, Column) - 1
'Faz a comparação'----------------If (TheArray(x, Column) > TheArray(x + 1, Column) And TheArray(x + 1, Column) <> Empty) Then'Ando por todas as colunas'-------------------------For y = 1 To ColumnCount
temp(x, y) = TheArray(x + 1, y)
Next y
'Ando por todas as colunas'-------------------------For y = 1 To ColumnCount
TheArray(x + 1, y) = TheArray(x, y)
Next y
'Ando por todas as colunas'-------------------------For y = 1 To ColumnCount
TheArray(x, y) = temp(x, y)
Next y
'Passou pelo if, então não está ordenado'---------------------------------------
sorted = FalseEndIfNext x
LoopEndFunction
'@Sort ArrayMulti
'@Data: 04/08/2010
'@Autor: André Tonini
' Esta função ordena um array multidimensional
' Parametros
' @TheArray - Array - Array que será ordenado
' @Column - Integer - Por qual coluna o array será ordenado
' @ColumnCount - Integer - O número de colunas do array
Public Function SortArrayMulti(ByRef TheArray As Variant, _
Column, _
ColumnCount)
'Variaveis
'----------
Dim temp()
Dim x, i, y As Integer
Dim sorted As Boolean
'Dimensões do array
'------------------
ReDim Preserve temp(1 To UBound(TheArray, Column), 1 To ColumnCount)
'Repetição para ordenar até o final do array
'--------------------------------------------
Do While Not sorted
'No inicio ele está ordenado
'--------------------------
sorted = True
'Laço que percorre as linhas
'----------------------------
For x = linhaCabecalho + 1 To UBound(TheArray, Column) - 1
'Faz a comparação
'----------------
If (TheArray(x, Column) > TheArray(x + 1, Column) And TheArray(x + 1, Column) <> Empty) Then
'Ando por todas as colunas
'-------------------------
For y = 1 To ColumnCount
temp(x, y) = TheArray(x + 1, y)
Next y
'Ando por todas as colunas
'-------------------------
For y = 1 To ColumnCount
TheArray(x + 1, y) = TheArray(x, y)
Next y
'Ando por todas as colunas
'-------------------------
For y = 1 To ColumnCount
TheArray(x, y) = temp(x, y)
Next y
'Passou pelo if, então não está ordenado
'---------------------------------------
sorted = False
End If
Next x
Loop
End Function
/// <summary>/// Ordena um listbox em ordem Ascendente/// </summary>/// <param name="ListBox">O controle ListBox a ser ordenado</param>/// <param name="ByValue">True se a ordenação deve ser feita pelo Valor(Value)/// ou False para orndenar pelo Texto (Text)</param> publicstaticvoid sortListBox(ref ListBox ListBox, bool ByValue){
SortedList ListItems =new SortedList();// adicionar os items do ListBox ao SortedList foreach(ListItem Item in ListBox.Items){if(ByValue) ListItems.Add(Item.Value, Item);else ListItems.Add(Item.Text, Item);}// limpa o controle
ListBox.Items.Clear();// adicionar o itens ordenadosfor(int i =0; i < ListItems.Count; i++){
ListBox.Items.Add((ListItem)ListItems[ListItems.GetKey(i)]);}}
/// <summary>
/// Ordena um listbox em ordem Ascendente
/// </summary>
/// <param name="ListBox">O controle ListBox a ser ordenado</param>
/// <param name="ByValue">True se a ordenação deve ser feita pelo Valor(Value)
/// ou False para orndenar pelo Texto (Text)</param>
public static void sortListBox(ref ListBox ListBox, bool ByValue)
{
SortedList ListItems = new SortedList();
// adicionar os items do ListBox ao SortedList
foreach (ListItem Item in ListBox.Items)
{
if (ByValue) ListItems.Add(Item.Value, Item);
else ListItems.Add(Item.Text, Item);
}
// limpa o controle
ListBox.Items.Clear();
// adicionar o itens ordenados
for (int i = 0; i < ListItems.Count; i++)
{
ListBox.Items.Add((ListItem)ListItems[ListItems.GetKey(i)]);
}
}
Como menciona o comentário, o segundo parâmetro define se os itens serão ordenados pela propriedade Value ou Text. Dei uma “brasileirada” no código. A referência original pode ser vista neste link:
Uma funcionalidade não nativa do VBA é a ordenação, seja lá ela qual for.
Ela comumente é necessária em Arrays e controles de lista, como ListBox e ComboBox. Métodos de ordenação existem aos montes. Neste caso, usarei o QuickSort, escrito pelo camarada Frederik do http://users.skynet.be/am044448/Programmeren/. O código abaixo faz a ordenação de um Array passado por parâmetro.
PrivateSub QuickSort(strArray() AsString, intBottom AsInteger, intTop AsInteger)
Dim strPivot AsString, strTemp AsStringDim intBottomTemp AsInteger, intTopTemp AsInteger
intBottomTemp = intBottom
intTopTemp = intTop
strPivot = strArray((intBottom + intTop) \ 2)
While (intBottomTemp <= intTopTemp)
While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
intBottomTemp = intBottomTemp + 1
Wend
While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
intTopTemp = intTopTemp - 1
Wend
If intBottomTemp < intTopTemp Then
strTemp = strArray(intBottomTemp)
strArray(intBottomTemp) = strArray(intTopTemp)
strArray(intTopTemp) = strTemp
EndIfIf intBottomTemp <= intTopTemp Then
intBottomTemp = intBottomTemp + 1
intTopTemp = intTopTemp - 1
EndIf
Wend
'faz a chamada recursiva a si própria até que lista esteja preenchidaIf (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop
EndSub
Private Sub QuickSort(strArray() As String, intBottom As Integer, intTop As Integer)
Dim strPivot As String, strTemp As String
Dim intBottomTemp As Integer, intTopTemp As Integer
intBottomTemp = intBottom
intTopTemp = intTop
strPivot = strArray((intBottom + intTop) \ 2)
While (intBottomTemp <= intTopTemp)
While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
intBottomTemp = intBottomTemp + 1
Wend
While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
intTopTemp = intTopTemp - 1
Wend
If intBottomTemp < intTopTemp Then
strTemp = strArray(intBottomTemp)
strArray(intBottomTemp) = strArray(intTopTemp)
strArray(intTopTemp) = strTemp
End If
If intBottomTemp <= intTopTemp Then
intBottomTemp = intBottomTemp + 1
intTopTemp = intTopTemp - 1
End If
Wend
'faz a chamada recursiva a si própria até que lista esteja preenchida
If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop
End Sub
A função não tem um retorno, mas como um array passado por parâmetro para um função é sempre por referência, após a execução desta seu Array estará ordenado em ordem crescente.
Para testar o funcionamento da função, crie um userForm no VBA. Coloque nele um ListBox e um CommandButton, sem se preocupar com alterar seus nomes. Coloque no código do Form a função QuickSort mostrada acima, mais o código abaixo.
PrivateSub CommandButton1_Click()
Dim MyArray(12) AsStringDim i AsLong'caso não haja itens na lista, não é necessário fazer ordenaçãoIf ListBox1.ListCount <= 1 ThenExitSub'alimenta o arrayFor i = 0 To ListBox1.ListCount - 1
MyArray(i) = ListBox1.List(i, 0)
Next i
'ordena o array
QuickSort MyArray, LBound(MyArray), UBound(MyArray)
'limpa o listbox
ListBox1.Clear
'usa o array ordenado para preencher o listboxFor i = 1 ToUBound(MyArray)
ListBox1.AddItem MyArray(i)
Next i
EndSubPrivateSub UserForm_Initialize()
'preenche o listbox com os meses do anoFor i = 1 To 12
ListBox1.AddItem MonthName(i, False)
NextEndSub
Private Sub CommandButton1_Click()
Dim MyArray(12) As String
Dim i As Long
'caso não haja itens na lista, não é necessário fazer ordenação
If ListBox1.ListCount <= 1 Then Exit Sub
'alimenta o array
For i = 0 To ListBox1.ListCount - 1
MyArray(i) = ListBox1.List(i, 0)
Next i
'ordena o array
QuickSort MyArray, LBound(MyArray), UBound(MyArray)
'limpa o listbox
ListBox1.Clear
'usa o array ordenado para preencher o listbox
For i = 1 To UBound(MyArray)
ListBox1.AddItem MyArray(i)
Next i
End Sub
Private Sub UserForm_Initialize()
'preenche o listbox com os meses do ano
For i = 1 To 12
ListBox1.AddItem MonthName(i, False)
Next
End Sub
Ao executar o form da primeira vez, pode-se ver que o ListBox é preenchido com os meses do ano através da função MontName.
Listbox Carregado com os meses
O código colocado no evento click do botão cria um array de string de tamanho 12, preenche o array com a lista de valores presente no listbox, ordena o array através da função QuickSort e re-preenche o listbox.
ListBox Ordenado
Uma forma bem simples de fazer ordenação em listas sempre precisar ficar re-pensando no código sempre que precisar.