Veremos en el post de hoy como generar en Excel un índice de todas las hojas que existan en nuestro libro de trabajo, pero en este caso asociándolo a unas Autoformas...
Tal como se ve en la imagen siguiente:
Esta personalización no permitirá crear rápidamente un índice de hojas empleando nuestras autoformas favoritas, con las características de formato de forma que deseemos...
Importante!, el índice se genera en una hoja que he llamado 'Menu'.
En un módulo estándar del libro incluimos el siguiente procedimiento:
El resultado se visualiza rápidamente.
Se observa como el orden de las hojas es el mismo en el que aparecen dispuestas en el libro...
Tal como se ve en la imagen siguiente:
Esta personalización no permitirá crear rápidamente un índice de hojas empleando nuestras autoformas favoritas, con las características de formato de forma que deseemos...
Importante!, el índice se genera en una hoja que he llamado 'Menu'.
En un módulo estándar del libro incluimos el siguiente procedimiento:
Sub CreaIndice_con_AutoForma() Dim wks As Worksheet alt = 0 For Each sh In Sheets If sh.Name <> "Menu" Then Set wks = Worksheets("Menu") Dim miForma As Shape 'definimos la forma de Rectángulo redondeado ' .AddShape ( Tipo , izquierda , arriba , ancho , alto ) Set miForma = wks.Shapes.AddShape(msoShapeRoundedRectangle, 5, 10 + alt, 75, 50) alt = alt + 60 'añadimos como texto el nombre de la hoja destino/ en negrita With miForma.TextFrame.Characters .Text = "Ir a " & sh.Name .Font.Bold = True End With 'alineamos texto centrado vertical/horizontal With miForma .TextFrame2.VerticalAnchor = msoAnchorMiddle .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter End With 'carácterísticas 3D de la forma con Bisel circular miForma.ThreeD.BevelTopType = msoBevelCircle 'y del color de fondo miForma.Fill.ForeColor.RGB = RGB(197, 90, 17) 'y también efecto de luminosidad With miForma.Glow .Color.RGB = RGB(197, 90, 17) .Transparency = 0.6 .Radius = 8 End With ' y finalmente añadimos la funcionalidad de hipervínculo a la Autoforma wks.Hyperlinks.Add Anchor:=miForma, _ address:="", _ SubAddress:=sh.Name & "!" & Cells(1, 1).address End If Next sh End Sub
El resultado se visualiza rápidamente.
Se observa como el orden de las hojas es el mismo en el que aparecen dispuestas en el libro...
gracias
ResponderEliminarMarca error de sintaxis
ResponderEliminarHola qué tal estás?
Eliminarun placer saludarte igualmente
ASegúrate que la fila 37:
address:="", _
te aparece el guión bajo después de un espacio en blanco
Saludos
Hola Isamel por favor me podrías ayudar con la siguiente macro
ResponderEliminarNecesito sumar un rango de una tabla de datos, según unos IDs y dos criterios, hasta el momento he conseguido que me sume el valor según el ID, pero necesito que me sume teniendo en cuenta el ID y los criterios 1 y 2
con esta macro sumo los ID pero necesito el requerimiento anterior
Sub sumarSS()
Set h11 = Sheets("EJEMPLO1")
Set h14 = Sheets("RESUMEN")
h14.Cells.ClearContents
h11.[B9:AB9].Copy h14.[B9]
h14.[A9] = "REG"
'
r = 1
For i = 10 To h11.Range("E" & Rows.Count).End(xlUp).Row
Set s = h14.Columns("E").Find(h11.Cells(i, "E").Value, lookat:=xlWhole)
If Not s Is Nothing Then
h14.Cells(s.Row, "Q").Value = h14.Cells(s.Row, "Q").Value + h11.Cells(i, "Q").Value
Else
u1 = h14.Range("A" & Rows.Count).End(xlUp).Row + 1
h14.Cells(u1, "A").Value = r
h14.Cells(u1, "E").Value = h11.Cells(i, "E").Value
h14.Cells(u1, "F").Value = h11.Cells(i, "F").Value
h14.Cells(u1, "Q").Value = h11.Cells(i, "Q").Value
r = r + 1
End If
Next
For h = 10 To h11.Range("G" & Rows.Count).End(xlUp).Row
Set p = h14.Columns("G").Find(h11.Cells(h, "G").Value, lookat:=xlWhole)
If Not p Is Nothing Then
h14.Cells(p.Row, "R").Value = h14.Cells(p.Row, "R").Value + h11.Cells(h, "R").Value
Else
u2 = h14.Range("A" & Rows.Count).End(xlUp).Row + 1
h14.Cells(u2, "A").Value = r
h14.Cells(u2, "G").Value = h11.Cells(h, "G").Value
h14.Cells(u2, "H").Value = h11.Cells(h, "H").Value
h14.Cells(u2, "R").Value = h11.Cells(h, "R").Value
r = r + 1
End If
Next
MsgBox "Fin"
End Sub
Con este otro código también logro sumar y resumir pero solo depediendo del ID también me falta que tenga el cuenta los dos criterios
ResponderEliminarSub ResumenID()
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("E2:E65535").RemoveDuplicates Columns:=1, Header:=xlNo
Range("F2").Select
ActiveCell.FormulaR1C1 = "=SUMIFS(C[-2],C[-5],RC[-1])"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F" & Application.WorksheetFunction.CountA(Range("e2:e65536")) + 1)
End Sub
Con el último código lo datos están de esta manera:
ResponderEliminarA1 B1 C1 D1 E1 F1
ID CC GRUPO TOTAL ID COSOLIDA TOTAL CONSOLIDADO
473 243 72 71000
473 243 72 66000
264 243 72 60000
264 243 72 72000
105 243 51 66000
264 231 72 66000
184 086 51 11000
473 233 51 17000
Hola Javier,
Eliminarpor que no empleas sencillamente la función SUMAR.SI.CONJUNTO (sumifs)...
=SUMAR.SI.CONJUNTO(rango_a_sumar;rng_criterio1;criterio1;rng_criterio2;criterio2)
es decir, trabaja sobre rangos y no sobre celdas...
Saludos
Muy bueno Ismael, gracias.
ResponderEliminarUn comentario, si las pestañas contienen espacios (por ejemplo 'hoja 1') entonces no funciona.
ResponderEliminarGracias Rubén,
Eliminarsi las hojas tienen espacios en blanco, la forma de llamarlas es empleando comillas simples.
En la fila 37 del código prueba:
SubAddress:="'" & sh.Name & "'!" & Cells(1, 1).address
Saludos