Saltar al contenido

Diagrama de arbol en excel (Contraer/Expandir directorios a lo regedit)


verzulsan

Recommended Posts

publicado

Buenas,

Aquí os dejo una de las mejoras que le he puesto a mi proyecto de estudio por Excel.

Se trata de un sistema de navegación entre directorios por exploración al igual que se puede hacer con el Regedit o con Windows Explorer, solo que en lugar de manejar objetos relacionados, simula dicha acción con las filas del Excel ocultándolas o mostrándolas. Para el ejemplo he cogido la ruta de directorios de Windows XP para que se entienda mejor el propósito, yo lo uso para definiciones de las materias que estoy estudiando.

Además de expandir o contraer directorios mediante Doble Click, tiene también la opción de lanzar una macro en caso de no estar en la zona de expansión/compactación. La hoja inicial no tiene ningún tipo de formato, ni formulas, ni rangos, es solo texto plano, todo lo que ocurre en la hoja es mediante macros. Para activar el programa, solo tenéis que hacer doble click en la celda A1.

Espero que os guste, me ha dado muchos dolores de cabeza.

Sistema Arbol.zip

publicado

Gracias Gerson, aun que para maestro aun me queda un rato jejeje, me considero mas estudiante que maestro.

Por cierto, ahora que lo dices, a ver si me pongo con las tablas dinamicas por que nunca las he usado y parece que dan bastante juego.

Un saludo!

publicado

verzulsan las tablas dinamicas se volvieron mas facil (no le temas jeje) que nunca desde 2007, es mas con toda humildad las nuevas versiones estan dirigidas a super novatos, ya que casi todo esta a la mano, solo es de estudiar un poco, hasta el VBA es mas claro, aunque este ultimo es mas complejo (porque hay manejar un poco el ingles), pero poco a poco se aprende mucho!:)

Saludos mi estimado

  • 10 months later...
  • 7 months later...
publicado

Me encantaría ver como hiciste esto, hay alguna manera??? es decir donde puedo ver como sacaste todo el árbol, para yo hacer un proceso similar pero de alguna carpeta en especial.

publicado
Me encantaría ver como hiciste esto, hay alguna manera??? es decir donde puedo ver como sacaste todo el árbol, para yo hacer un proceso similar pero de alguna carpeta en especial.

El aporte no tiene nada que ver con sacar todo un arbol de carpetas, de todas formas te digo el nombre del programa que usé para sacar el listado que has visto en el ejemplo: "Directory Lister", te crea un listado de todos los archivos y carpetas del directorio que elijas; tras personalizar las opciones de busqueda para que solo muestre la info que se quiera, luego solo hay que hacer varios filtrados en excel para sacar el arbol y las tabulaciones que separan los niveles.

Aqui te dejo la web:

List Files with Directory Lister Pro

¿He contestado tu pregunta?

Saludos

  • 1 year later...
  • 2 months later...
publicado

Hola verzulsan, he usado tu macro y me ha servido muchisimo, sólo un pregunta por curiosidad, ¿la macro se puede hacer a la inversa?, es decir, ¿se puede ocultar las filas de arriba si el titulo esta abajo?, saludos.

publicado

Hola Onardem, me alegro que te sirva,

Seguramente se pueda pero no se si te he entendido bien, ¿podrias poner un ejemplo de como iria eso de las filas arriba y el titulo debajo?, saludos

publicado

Hola verzulsan, anexo un extracto de tu archivo acomodado al revés, en donde la unidad "C:" esta al final de las filas; en vez de ocultar las filas que estan abajo se oculten las que están arriba como en los subtotales, agregue colores a los niveles para que se aprecien mejor.

Espero haberme explicado.

Saludos.

Sistema Arbol - copia.xls

publicado

Con el ejemplo te he entendido, es decir, quieres que actue exactamente igual que lo hace ahora pero en sentido contrario, como si abajo fuera arriba y arriba abajo.

Intenta coger la logica del algoritmo y luego dale la vuelta a cada bucle, creo que son las variables

Dim FilUp As Integer 'La fila en la que empieza el rango de compactacion

Dim FilDown As Integer 'La fila en la que acaba el rango de compactacion

Dim FilEOF As Integer 'El final de la hoja, solo para el ultimo segmento de compactacion

Edit: Tengo unos minutos a ver si consigo que funcione y te lo paso.

publicado

Creo que lo tengo, puede tener algunos fallitos pero como va el algoritmo duplicado en dos módulos diferentes (uno funciona al derecho "Compactar" y otro al revés "Compactar2") puedes compararlos para mejorarlo como mejor te convenga.

Descargar Sistema Arbol al reves

Saludos

PD: Hola Enigma25, gracias por los cumplidos, me alegra que te haya gustado y saludos para ti también. :)

PD2: Me estaba preguntando ahora que he terminado ¿El sistema de árbol al revés que aplicaciones tiene? ¿Para zurdos? ¿Para disléxicos?, Es solo curiosidad, si no se puede decir no pasa nada ;)

Saludos2

publicado

Hola @[uSER=33269]verzulsan[/uSER], disculpa apenas puede conectarme para ver las respuestas.

Es genial tu archivo, cada vez me sorprendo más, yo intente modificarlo antes, pero en las pruebas que hice, sólo funciono algunas veces pero me marcaba error y otra veces solo me mostraba algunas filas y otras no.

Respecto a tu duda, verás, soy contador por profesión y aficionado al excel por adicción, jejeje, así que elaboro mis propias cédulas con formulas y macros, y en hace unos días me di a la tarea de hacer un análisis (ya que no tenia que hacer) sobre un presupuesto de gastos personales, por lo que use tu macro, pero, cuando estaba viendo como se ocultaban y mostraban las filas, se me acerco un colega y me dijo que si le podía ayudar hacerlo con un archivo que él tiene, entonces viendo su archivo, note que utilizaba la opcion de subtotales acumulando la suma total en la parte de abajo, por lo que las partidas integrantes estaban en las filas superiores, y me pregunte si se podría hacer de manera inversa la macro, así fue como retome la publicación y te pregunte.

Usos creo que hay varios, entre ellos se me ocurren: resumenes tipo tabla dinámica, presentaciones de proyectos de forma compacta, para sustituir la opción de subtotales, y de ahí hasta donde la imaginación alcance.

Muchas gracias @verzulan, en hora buena, he aprendido mucho de tus aportes.

Saludos.

Jesús.

  • 3 months later...
  • 5 months later...
publicado

Buen dia¡¡ Me gustaria si alguien me puede asesorar para realizar este mismo porceso, veo que la entrada es de hace años..... ando haciendo algo similar pero en el archivo no identifico la forma de poder hacer la contraccion y la expansion¡¡¡¡ Ayudaaaaa

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.