HOLA!!!
No hice exactamente lo que pedias, mi funcion te devuelve un array con todos los primeros en el indice (0,x) todos los segundos en el indice (1,x) y los terceros ordenados en el indice (2,x)
Private Function Clasificados(Player() As String, Score() As Integer, Ranking() As Integer) As Long()
Dim W, X, Y, Z As Integer
Dim Todos() As Long
Dim AuxP(3) As Long
Dim AuxI(3) As Long
Dim Aux As Long
ReDim Todos(2, ((UBound(Player) + 1) / 4) - 1)
'ORDENO EN TODOS DE LA SIGUIENTE MANERA
'TODOS(0,X) = JUGADORES PRIMEROS DE CADA ZONA
'TODOS(1,X) = JUGADORES SEGUNDOS DE CADA ZONA
'TODOS(2,X) = JUGADORES TERCEROS DE CADA ZONA
For X = 0 To UBound(Player) Step 4
For Y = 0 To 3
AuxP(Y) = Ranking(X + Y)
AuxI(Y) = X + Y
Next
For Y = 0 To 3
For Z = 0 To 3
If AuxP(Y) > AuxP(Z) Then
Aux = AuxP(Y)
AuxP(Y) = AuxP(Z)
AuxP(Z) = Aux
Aux = AuxI(Y)
AuxI(Y) = AuxP(Z)
AuxI(Z) = Aux
End If
Next
Next
For W = 0 To 2
If AuxP(W) <> AuxP(W + 1) Then
Todos(W, ((X + 1) / 4) - 1) = AuxI(W)
Else
If Score(AuxI(W)) > Score(AuxI(W + 1)) Then
Todos(W, ((X + 1) / 4) - 1) = AuxI(W)
Else
Todos(W, ((X + 1) / 4) - 1) = AuxI(W + 1)
End If
End If
Next
Next
'ORDENO LOS TERCEROS (POR QUE LOS OTROS NO SE NECESITAN ORDENADOS
For X = 0 To 3
For Y = 0 To 3
If Ranking(Todos(2, X)) > Ranking(Todos(2, Y)) Then
Aux = Todos(2, X)
Todos(2, X) = Todos(2, Y)
Todos(2, Y) = Aux
End If
Next
Next
For X = 0 To 2
For W = 0 To 2
If Ranking(Todos(2, W)) = Ranking(Todos(2, W + 1)) Then
If Score(Todos(2, W)) < Score(Todos(2, W + 1)) Then
Aux = Todos(2, W)
Todos(2, W) = Todos(2, W + 1)
Todos(2, W + 1) = Aux
End If
End If
Next
Next
Clasificados = Todos()
'DEVUELVE:
'TODOS: 0 1 2
'X PRIMERO GRUPO X SEGUNDO GRUPO X TERCERO EN ORDEN
End Function
GRACIAS POR LEER!!!
Mostrar Mensajes
(por buscador y mi nick)