Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » AGRUPAR FILAS Y COLUMNAS EN MACROS

Excel - AGRUPAR FILAS Y COLUMNAS EN MACROS

Volver
Nuevo Tema
<<>>
 
Vista:
Imágen de perfil de Jvnto

AGRUPAR FILAS Y COLUMNAS EN MACROS

Publicado por Jvnto (13 intervenciones) el 29/10/2015 23:51:28
Estimados,

Quería pedirle un apoyo

He estado tratando de realizar una macro para poder agrupar las filas y columnas de una base de datos parecida al que se tiene adjuntado, pero no lo he podido conseguir.

En el documento adjunto la data_origen, la cual es el archivo original. Y la segunda que es data_trabajada es como debería de quedar el documento.

Me gustaría saber si es posible ponerle rangos dinámicos, dado que pueda que el próximo mes la data pueda crecer, pero las columnas serian las mismas, y los colores también.

Muchas Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Jvnto

AGRUPAR FILAS Y COLUMNAS EN MACROS

Publicado por Jvnto (13 intervenciones) el 03/11/2015 17:45:46
Logre escribir este código, donde me están corriendo correctamente las columnas, pero aún tengo algunas fallas técnicas, creo que es con la variable Boolean.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub AGRUPON()
Dim Inicio As Integer
Dim Final As Integer
Dim Auxiliar As Integer
Dim A, B As Integer
Dim FinDatos As Boolean
Dim TotalFilas As Double
Dim num As String
 
FinDatos = False
Auxiliar = 1
A = Auxiliar
Inicio = 1
num = 3
 
Range("F16").End(xlDown).Select
TotalFilas = ActiveCell.Row
 
 
'Range("J3806").Select

 
 
For Col = 0 To 11
For x = 1 To TotalFilas
 
Range("A1").Offset(0, Col).Value = num
            num = num + 1
            Letra = Letra_Columna(num)
 
    For A = Inicio To TotalFilas
        If Range(Letra & Trim(Str(A))).Value = "Resultado" Then
            Inicio = A + 1
            Exit For
        End If
    Next A
 
    If Inicio = TotalFilas Then Exit Sub
 
    For B = Inicio To TotalFilas
        If Range(Letra & Trim(Str(B))).Interior.ColorIndex <> 42 Or Range(Letra & Trim(Str(B))).Borders.LineStyle <> 1 Then
            If Range(Letra & Trim(Str(B))).Borders.LineStyle <> 1 Then FinDatos = True
            Final = B - 1
            Exit For
        End If
    Next B
    If Inicio <> TotalFilas And Final <> 0 Then
        Rows(Trim(Str(Inicio)) & ":" & Trim(Str(Final))).Select
        Selection.Rows.Group
        Inicio = Final + 1
    End If
 
    If FinDatos=True Then Exit For
 
Next x
Next Col
 
fin:
End Sub

1
2
3
4
5
Function Letra_Columna(ByVal Col As Long) As String
 
Letra_Columna = Replace$(Cells(1, Col).Address(False, False), "1", "")
 
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar