domingo, 1 de abril de 2012

VBS - Ordenación de un array (matriz)




  Si tenemos un conjunto de valores asignado a un array de variables y queremos ordenarlos por orden alfabético o numérico, podemos hacerlo usando el siguiente script.
 



Con este script generaremos un nuevo array con los valores ordenados por orden alfabético ó numérico según queramos:

'Ordenacion de los valores de un array por orden alfabético ó numérico - by JoMoLo (2007) v2.0

'------------------------------------------------------------------------------------------------------------------
'Creamos un array de ejemplo usando NombresDes como array origen y NombresOrd como array destino
Dim NombresDes(), NombresOrd 'declaramos el array original y el nombre de array ordenado (tal cual sin parentesis)
ReDim NombresDes(10) ' creamos el array de ejemplo
NombresDes(1) = "casa"
NombresDes(2) = "perro"
NombresDes(3) = "casado"
NombresDes(4) = "pera"
NombresDes(5) = "arbol"
NombresDes(6) = "Axe"
NombresDes(7) = "zapato"
NombresDes(8) = "perro"
'------------------------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------------------
'En las siguientes lineas, sustituiremos NombresDes y NombresOrd por nuestros arrays origen y destino
Dim orden(), desorden 'estos array son temporales y los necesita la Sub de ordenación
desorden = NombresDes 'duplicamos el array original con otro de nombre fijo "desorden".
Erase NombresDes 'eliminamos el array original (si no se va a necesitar posteriormente)
'------------------------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------------------
'iniciamos la ordenacion
Dim x
'x = -1
x = 0
For Each celda In desorden 'lanzamos un bucle con tantos ciclos como valores tiene el array
'Buscamos el valor mas pequeño en cada vuelta
n = -1: repe = 1
For Each valor In desorden
n = n + 1
If valor <> "" Then
If peque = "" Then
peque = valor
numpeque = n
Else
'ORDENACION ALFABETICA ----------
'If UCase(valor)=UCase(peque) Then desorden(n)="" 'LINEA OPCIONAL: es para eliminar valores repetidos
'If UCase(valor)=UCase(peque) Then repe=repe+1 : desorden(n)=desorden(n)&"_"&repe 'LINEA OPCIONAL: es para renombrar valores repetidos
If UCase(valor) < UCase(peque) Then peque = valor: numpeque = n 'ORDENACION NUMERICA ------------ 'If valor = peque Then desorden(n) = "" 'LINEA OPCIONAL: es para eliminar valores repetidos 'If valor = peque Then repe = repe + 1: desorden(n) = desorden(n) & "_" & repe 'LINEA OPCIONAL: es para renombrar valores repetidos 'If valor < peque Then peque = valor: numpeque = n End If End If Next 'Asignamos el valor mas pequeño de este ciclo a la variable del nuevo array "orden" If peque <> "" Then x = x + 1: ReDim Preserve orden(x): orden(x) = peque
'msgbox orden(x)

'ponemos a null estas celdas del array
desorden(numpeque) = ""
peque = ""
Next
'------------------------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------------------
'En las siguientes lineas, sustituiremos NombresDes y NombresOrd por nuestros arrays origen y destino
NombresOrd = orden 'la ordenacion nos devuelve el array temporal "orden" y lo duplicamos con el nombre que hemos elegido al inicio
Erase orden 'eliminamos este array temporal
'------------------------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------------------
'linea de comprobación del resultado
MsgBox NombresOrd(1) & " " & NombresOrd(2) & " " & NombresOrd(3) & " " & NombresOrd(4) & " " & NombresOrd(5) & " " & NombresOrd(6) & " " & NombresOrd(7) & " " & NombresOrd(8)
'------------------------------------------------------------------------------------------------------------------









No hay comentarios:

Publicar un comentario