Macro valor máximo por columnsa y crear pares

Tengo una tabla, con varias columnas, debo crear pares formados por siempre la celda de la columna A con el valor máximo de cada columna siguiente, por ejemplo AB, AC, AD, AF
A B C D F
W 2 4 2 1
X -1 3 5 2
Y 1 0 2 3
Z 4 2 1 -1
Como resultado la lista los pares generados serian
Z 4
W 4
POR 5
Y3

1 Respuesta

Respuesta
1
Listo esta macro hace lo que necesitas, solo la debes adaptar a tu archivo, yo la probé y funciona
Sub Macro1()
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Columns("A:E").Select
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A1:A65000"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SetRange Range("A1:E65000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
a = a + 1
Contador = Contador + 1 ' Incrementa el contador.
If Range("A" & a).Value = "" Then ' Si la condición es verdadera.
Comprobar = False ' Establece el valor a False.
Else
Range("F" & a).Value = "=A" & a & "&" & "MAX(B" & a & ":D" & a & ")"
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Range("F:F").Select
Selection.Copy
Application.CutCopyMode = False
Range("F1").Select
End Sub
Hola, si funciona, ¿pero cómo hacer para que trabaje con N columnas?, ya que el archivo que genero trae un numero variable de columnas,
Muchas gracias y disculpa tanta molestia
Saludos
Lo podemos hacer con un input, es decir, al correr la macro te va a preguntar cual es la ultima columna a revisar
Sub Macro1()
ki = inputbox("Ingrese el nombre de la ultima columna del rango")
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Columns("A:"& ki).Select
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Hoja1").Sort.SortFields.Add Key:=Range("A1:A65000"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Hoja1").Sort
.SetRange Range("A1:" & ki & "65000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Do ' Bucle externo.
Do While Contador < 65000 ' Bucle interno.
a = a + 1
Contador = Contador + 1 ' Incrementa el contador.
If Range("A" & a).Value = "" Then ' Si la condición es verdadera.
Comprobar = False ' Establece el valor a False.
Else
cell ( a, ki +1).value= "=A" & a & "&" & "MAX(B" & a & ":D" & a & ")"
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Range(ki).Select
Selection.Copy
Application.CutCopyMode = False
Range(ki & "1").Select
End Sub
Prueba y me avisas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas