|
Hola Lucas, ahora si, ya nos entedemos, como critica constructiva, observa que es mejor desde un principio ser lo mas claro posible, no creess??...
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 cuestion, la que escogi fue casi solo por el gusto de complicarme las cosas...
1.- Ordenamos por la columna D (la de los agentes)
2.- Obtenemos los subtotales con la operacion Cuenta de esta columna, esto es para saber cuantas filas tenemos de cada agente
4.- Guardamos el nombre del agente y la direccion 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 estan tus datos, estoy asumiendo que...
1.- Los datos tienen titulos 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 informacion
ReDim mRangos(1, rVisibles.Cells.Count - 3)
'Iteramos cada celda visible
For Each c In rVisibles
co1 = co1 + 1
'La primer fila contiene los titulos 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
|
