Definir un rango a partir del valor de una columna

Admirado Valedor,
Necesito definir un rango a partir del valor de una columna.
Tengo una tabla de excel de 6 columnas por 8000 líneas. La columna b puede tener 8 o 10 variables, siempre correlativas. Se trata de que una macro cree los rangos a partir del valor de la columna b. Después de haber visto algunas de tus respuestas creo que debe ser muy fácil para ti. Gracias anticipadas,
Lucas.

1 respuesta

1
Respuesta de
Hola Lucas, ahora si, ya nos entedemos, como critica constructiva, observa que es mejor desde un principio ser lo más claro posible, ¿no crees?...
Bien, lo que tenias que haber hecho es grabar una macro exactamente con los pasos que mencionas, como primero prueba, esto te recomiendo hacerlo siempre...
Como casi siempre, hay varias soluciones a la cuestión, la que escogí fue casi solo por el gusto de complicarme las cosas...
1.- Ordenamos por la columna DE (la de los agentes)
2.- Obtenemos los subtotales con la operación Cuenta de esta columna, esto es para saber cuantas filas tenemos de cada agente
4.- Guardamos el nombre del agente y la dirección del rango
4.- Quitamos los subtotales
5.- Iteramos entre los agentes definiendo cada rango con el numero de filas encontrado con la estructura
Rango_NombreAgente
Ejecuta la siguiente macro en la hoja donde están tus datos, estoy asumiendo que...
1.- Los datos tienen títulos en la primer columna
2.- Estos comienza en la fila 1
2.- NO hay filas en blanco dentro de tus datos
Option Explicit
Public Sub DefinirRangos()
Dim rVisibles As Range
Dim co1 As Integer, co2 As Integer
Dim c As Range
Dim Inicio As Long, Fin As Long
Dim mRangos() As String
Application.ScreenUpdating = False
'Ordenamos por la columna D la de los agentes
Range("A1").CurrentRegion.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Agregamos un subtotal para saber cuantos y cuales agentes hay
Range("A1").CurrentRegion.Subtotal GroupBy:=4, Function:=xlCount, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'Contraemos para ver solo los totales
ActiveSheet.Outline.ShowLevels RowLevels:=2
'Seleccionamos solo las celdas visibles
Set rVisibles = Range(Range("D1"), Range("D1").End(xlDown)).SpecialCells(xlCellTypeVisible)
Inicio = 2
'Redimencionamos la matriz donde guardaremos información
ReDim mRangos(1, rVisibles.Cells.Count - 3)
'Iteramos cada celda visible
For Each c In rVisibles
co1 = co1 + 1
'La primer fila contiene los títulos y la ultima el total
'general, por eso las omitimos
If co1 > 1 And co1 < rVisibles.Cells.Count Then
'Calculamos donde termina el rango del agente actual
Fin = Inicio + c.Value - 1
'Guardamos el nombre del agente para definir el rango
mRangos(0, co2) = "Rango_" & Mid(c.Offset(0, -1).Value, 9)
'Guardamos la direccion del rango
mRangos(1, co2) = "=" & ActiveSheet.Name & "!$A$" & Format(Inicio) & ":$F$" & Format(Fin)
'Calculamos el inicio del siguiente rango
Inicio = Inicio + c.Value
'Incrementamos el contador usado en la matriz
co2 = co2 + 1
End If
Next c
'Eliminamos los subtotales
Range("D1").RemoveSubtotal
'Agregamos los rangos con la informacion recabada
For co1 = 0 To UBound(mRangos, 2)
ActiveWorkbook.Names.Add Name:=mRangos(0, co1), _
RefersTo:=mRangos(1, co1)
Next co1
Application.ScreenUpdating = True
'Liberamos la memoria
Erase mRangos
Set rVisibles = Nothing
End Sub
Añade un comentario a esta respuesta
Añade tu respuesta
Haz clic para o
Escribe tu mensaje