UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo


No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1 Optimizar macro el 24/04/17, 02:54 pm

eneada


Hola a tod@s,

Bueno pues esta "nada optimizada" macro tiene varios objetivos y varios problemas.

Tengo un libro con una hoja por cada cliente, más de 150 hojas (y afortunadamente creciendo), del cual pretendo extraer ciertos datos (visitas totales de cada cliente). Así podré analizar la información por meses y tratar de mejorar el servicio a mis clientes. Bueno, al menos, esa es mi teoria Smile

Todas las hojas tienen la misma estructura y mi objetivo es:
- Extraer la información de la comlumna "C18" en adelante (donde están las fechas de cada visita del cliente) junto con las celdas "A" de la misma fila (productos) y la celda "A2" que me va a indicar el nombre del cliente
 Y esta información llevarla al libro "TtosMes.xlsx", "hoja1"

El problema es que, no se que hice en alguna de las pruebas, que ahora solo me saca las 9 primeras filas de la información ... además que no he logrado un bucle que recorra desde la "C18" hasta la última celda con datos, de cada hoja (empezando por la hoja 5); asi que mi solución ha sido crear, manualmente, el recorrido por las 9 primeras celdas ("C18:C26")... una a una ...

Otra opción que he intentado es extraer todas las columnas "C" completas, desde la "C18" hasta la última con datos y desde la hoja 5 en adelante, pero me ha resultado aún más complicado. 

¿Alguien que me oriente y pueda optimizar este "prehistórica" macro? En el archvo adjunto estan las macro por separado (5 y6 ) y unidas (7)

Este es el código:

Sub z_info_mes()
Dim Fila As Long, Hoja As Worksheet
Sheets("AA_Datos").Cells.ClearContents
For Each Hoja In ThisWorkbook.Worksheets
   If Hoja.Name <> ActiveSheet.Name Then
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C18")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A18")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C19")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A19")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C20")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A20")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C21")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A21")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C22")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A22")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C23")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A23")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C24")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A24")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C25")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A25")
      Fila = Fila + 1
      Sheets("AA_Datos").Range("A" & Fila) = Hoja.Range("A2")
      Sheets("AA_Datos").Range("B" & Fila) = Hoja.Range("C26")
      Sheets("AA_Datos").Range("C" & Fila) = Hoja.Range("A26")

   End If
Next
End Sub

Sub zz_Libro_ttosmes()
 
'Definir objetos a utilizar
Dim wbDestino As Workbook, _
    wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
     
'Indicar el libro de Excel destino
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "\TtosMes.xlsx")
 
'Activar este libro
ThisWorkbook.Activate
 
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("AA_Datos")
Set wsDestino = wbDestino.Worksheets("Hoja1")
 
'Indicar la celda de origen y destino
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
 
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
 
'Seleccionar rango de celdas origen
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
 
'Pegar datos en celda destino
rngDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False
 
'Guardar y cerrar el libro de Excel destino
wbDestino.Save
wbDestino.Close
 
End Sub
Archivos
zz_Datos Pacientes RECEPCION.xlsm
No tienes los permisos para descargar los archivos.
(97 KB)

2 Re: Optimizar macro el 24/04/17, 11:00 pm

jhon1904

avatar
Hola
Eneada

la macro que planteas optimizar no es difícil, lo único es que tienes que replantear la base de datos que estas trabajando, para que asi se mas optima, por ejemplo:

cree en una hoja la base de datos de los clientes con id para que sean únicos, en otra hoja cree los tratamientos que toman cada cliente, en otra hoja lo recibos de pago, y asi tienes que crear todas las tablas que sean necesarias.

con el fin de que sea mas eficiente y en ves de utilizar 50 hojas o mas solo utilizaras 4 o 5 como maximo y tendrás toda la información en concentrada.

saludos,


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

3 Re: Optimizar macro el 25/04/17, 10:41 pm

jhon1904

avatar
Hola,

Subo un ejemplo, que hice con el archivo que estas manejando para que lo veas y me cuentes.

he creado tres  hojas y tres formularios.

la hoja de clientes la cual es alimentada con el formulario de crear clientes.

la hoja de base de datos que es alimentada con  los tratamientos que toman cada cliente y lleva su historial, este formulario es  una similitud de la plantilla de la hoja que tienes.

la hoja de recibo de pago, la cual se alimenta del formulario de recibo cuando los clientes realizan un abono según sea el tratamiento.

 de este modo podrás trabajar infinitos clientes, tratamientos y tener un historial mas concreto y fácil de utilizar.

saludos,
Archivos
zz_Datos Pacientes RECEPCION.xlsm
No tienes los permisos para descargar los archivos.
(151 KB)


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

4 Re: Optimizar macro el 26/04/17, 01:24 pm

jhon1904

avatar
Hola

Si deseas utilizarlo como esta tu archivo, este seria el código

Código:
Sub z_info_mes()
Dim dato As String
Dim fila2
Dim fila As Long, Hoja As Worksheet
fila = 2
Sheets("AA_Datos").Cells.ClearContents
For Each Hoja In ThisWorkbook.Worksheets
dato = Left(Hoja.Name, 7)
  If dato = "Cliente" Then
      fila2 = Hoja.Range("A" & Rows.Count).End(xlUp).Row
      For I = 18 To fila2
        Hoja153.Range("A" & fila) = Hoja.Range("A2")
        Hoja153.Range("B" & fila) = Hoja.Range("A" & I)
        Hoja153.Range("c" & fila) = Hoja.Range("B" & I)
        Hoja153.Range("d" & fila) = Hoja.Range("C" & I)
        Hoja153.Range("e" & fila) = Hoja.Range("D" & I)
        Hoja153.Range("f" & fila) = Hoja.Range("E" & I)
        Hoja153.Range("g" & fila) = Hoja.Range("F" & I)
        Hoja153.Range("h" & fila) = Hoja.Range("G" & I)
        Hoja153.Range("I" & fila) = Hoja.Range("H" & I)
        fila = fila + 1
        Next I
  End If
Next
End Sub



saludos espero te sirva


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

5 Re: Optimizar macro el 27/04/17, 02:43 pm

eneada


Excelente, GRACIAS !! Smile

6 Re: Optimizar macro el 28/04/17, 12:03 am

Igtelo

avatar
Hola eneada.

Por favor cumple las normas del foro, cierra el tema como debe ser.

Saludos
Ignacio Téllez

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.