Generar_Agrupadores_Macro

[Johan Ventosilla]

Estimados,

Favor su apoyo, en el archivo adjunto he colocado dos pestañas:

1. La base que necesito agruparlos con macros

2. La base como debería de quedar

Estuve consultando, y me compartieron este código pero no lo he logrado realizar, les comparto el código:

 

Favor su apoyo con eso, gracias!!

Generar_Agrupadores_Macro.xlsx

[bigpetroman]

@Johan Ventosilla revisa tu solicitud, según veo las dos hojas son identicas, no se entiende que es lo que quieres

 

 

[Johan Ventosilla]

Hola @bigpetroman gracias por la duda, mira te explico. En la hoja 1 es la base original o como la tengo ahorita (desagrupada) y la hoja 2 es  un bosquejo de la misma base pero como quisiera tenerlo (agrupada).

En resumen, la macro debería de ejecutarse en la hoja 1. Esté resultado debería ser igual a lo que tengo en la Hoja 2.

Espero haberme  hecho explicar, favor tu apoyo!

Gracias!

 

 

[bigpetroman]

Saludos @Johan Ventosilla, revisa el anexo, ejecuta la macro con CTRL+k en la hoja activa

 

Suerte

Generar_Agrupadores_Macro.xlsm

[Johan Ventosilla]

Hola @bigpetroman eres un crack!!. Pero tengo una consulta adicional. En el adjunto, he colocado dos pestañas:

1. Agrupadores sin repetir etiquetas: Esta fue la que consulte, y esta realmente genial!!

2. Agrupadores cuando se repiten etiquetas: Como sería de esta forma?, trate de correr tu macro con un par de modificaciones pero me salió algo desordenado. Lo pregunto, ya que recibo info de estas dos formas  

Gracias de antemano por la ayuda!!,

Generar_Agrupadores_Macro_v2.xlsm

[bigpetroman]

Saludos @Johan Ventosilla, la segunda macro quedaría asi

 

Sub CrearAgrupacion_Conetiquetas()
    Dim nFilTot As Double
    Dim wHoja As Worksheet
    Dim nFilIni As Double
    Dim nFilFin As Double
    Dim rCelda As Range
    Dim n As Integer
    Dim nAjuste As Integer
    
    Set wHoja = ActiveSheet
    
    'Limpiamos cualquier esquema previo
    wHoja.Cells.ClearOutline
    
    'Obtenemos la fila final
    nFilTot = wHoja.Range("A" & Rows.Count).End(xlUp).Row
    
    'creamos los 3 esquemas de agrupaciones
    For n = 0 To 2
        nFilIni = 4
        nFilFin = 0
        For Each rCelda In wHoja.Range("A4").Offset(0, n).Resize(nFilTot - 3)
            'si la celda es diferente de vacio, agrupamos el rango
            If Left(rCelda.Value, 5) = "Total" Then
                nFilFin = rCelda.Row - 1
                'wHoja.Range("A" & nFilIni & ":A" & nFilFin).Select
                wHoja.Range("A" & nFilIni & ":A" & nFilFin).Rows.Group
                nAjuste = 0
                Select Case n
                    Case 1
                        If Left(rCelda.Offset(1, -1).Value, 5) = "Total" Then nAjuste = 1
                    Case 2
                        If Left(rCelda.Offset(1, -1).Value, 5) = "Total" And Left(rCelda.Offset(2, -2).Value, 5) = "Total" Then
                            nAjuste = 2
                        ElseIf Left(rCelda.Offset(1, -1).Value, 5) = "Total" Then
                            nAjuste = 1
                        End If
                End Select
                nFilIni = rCelda.Row + 1 + nAjuste
            End If
        Next
    Next
    
    Set wHoja = Nothing
End Sub

suerte