Saltar al contenido

De modelo CUADRANTE de TURNOS a modelo BASE de DATOS


Recommended Posts

Ok os mando este archivo para que por favor me ayudéis a dejar este código mejor ... yo soy matemático ... solo llevo un par de año con las macros y con vosotros .... y me gusta mucho cuando me dais perspectivas nuevas de cómo hacer las cosas. Como siempre muchas gracias de antemano por vuestra valiosa atención.

image.thumb.png.e4e2510c89a091b0a1d80816f13d04b1.pngimage.thumb.png.3e28d64a6c0bb1b0785ef6949b8b1620.png

deCuaABAse.xlsm

Enlace a comentario
Compartir con otras webs

Esta macro convierte el cuadrante de turnos en formato tabla de BD.

Válida para cualquier mes y número de trabajadores.

Sub aBaseDeDatos()
Application.ScreenUpdating = False
With Sheets("DeCuaABase")
   .Range("A8").CurrentRegion.Offset(1).ClearContents
   fila = 8
   For y = .Range("S9").Column To .Cells(8, Columns.Count).End(xlToLeft).Column
      For x = 8 To .Range("R" & Rows.Count).End(xlUp).Row
         fila = fila + 1
         .Range("A" & fila) = .Cells(x, 17)
         .Range("B" & fila) = .Cells(6, y)
         .Range("C" & fila) = .Cells(x, 18)
         .Range("D" & fila) = .Cells(x, y)
      Next
   Next
End With
Application.ScreenUpdating = True
End Sub

 

Enlace a comentario
Compartir con otras webs

Hace 8 horas, Antoni dijo:

Esta macro convierte el cuadrante de turnos en formato tabla de BD.

Válida para cualquier mes y número de trabajadores.

Sub aBaseDeDatos()
Application.ScreenUpdating = False
With Sheets("DeCuaABase")
   .Range("A8").CurrentRegion.Offset(1).ClearContents
   fila = 8
   For y = .Range("S9").Column To .Cells(8, Columns.Count).End(xlToLeft).Column
      For x = 8 To .Range("R" & Rows.Count).End(xlUp).Row
         fila = fila + 1
         .Range("A" & fila) = .Cells(x, 17)
         .Range("B" & fila) = .Cells(6, y)
         .Range("C" & fila) = .Cells(x, 18)
         .Range("D" & fila) = .Cells(x, y)
      Next
   Next
End With
Application.ScreenUpdating = True
End Sub

 

Muchas gracias, Antoni qué pasada de MACRO. You are the best!

Enlace a comentario
Compartir con otras webs

Tengo algunas preguntas ....

Si solo quisiera añadir un día en particular o un grupo de 3 días de ese mes .... ya que es un pronóstico y si y solo si los trabajadores han asistido y realizado sus turnos pronosticados entonces lo pasaría a base de datos.

Has ahora con mi código puedo por ejemplo pasar un dia:

image.thumb.png.add073c7b5631b1eb8995731e8a9796a.png

Pasar la mitad de los trabajadores de 1 dia: 

image.thumb.png.c73a2a06b02771645e03c066f2f884e1.png

Pasar un solo trabajador de un día: PERO siempre empezando desde la fila 8 por la manera en la que he realizado el CODIGO

image.thumb.png.d2e55158f65521682828095ca26a2662.png

Podemos pasar dos días o tres días cualesquiera siempre que se empiece desde arriba ....

image.thumb.png.1bae0b593213161851bb18a06e57b27a.png

Me gustaría añadir un identificador más a mi código para que de manera selectiva tener la funcionalidad de pasar la celda seleccionada de manera correcta, se 1 o una columna, se empiece por el principio de la columna o a media columna.

EJEMPLO DE FALLO : ya que la fecha lleva CDate de manera que me aseguro de que coja la fecha si o si. Es decir, si inicio el paso de datos desde la celda S10 no funciona.

image.thumb.png.df964e9e171909563f5b0ff9295cfaa3.png

 

Enlace a comentario
Compartir con otras webs

Hace 9 horas, Antoni dijo:

Esta macro convierte el cuadrante de turnos en formato tabla de BD.

Válida para cualquier mes y número de trabajadores.

Sub aBaseDeDatos()
Application.ScreenUpdating = False
With Sheets("DeCuaABase")
   .Range("A8").CurrentRegion.Offset(1).ClearContents
   fila = 8
   For y = .Range("S9").Column To .Cells(8, Columns.Count).End(xlToLeft).Column
      For x = 8 To .Range("R" & Rows.Count).End(xlUp).Row
         fila = fila + 1
         .Range("A" & fila) = .Cells(x, 17)
         .Range("B" & fila) = .Cells(6, y)
         .Range("C" & fila) = .Cells(x, 18)
         .Range("D" & fila) = .Cells(x, y)
      Next
   Next
End With
Application.ScreenUpdating = True
End Sub

 

IMPRESIONANTE VELOCIDAD MATCH 10

Enlace a comentario
Compartir con otras webs

Sub aBaseDeDatos()
    Dim IniciarTiempo As Double
    IniciarTiempo = Timer
 
    Dim cel As Range, rng As Range
    Dim txt1 As String, fecha As String, dato As String, buscarv As String
    Dim recuadroVerde As Variant, ultima As Variant
    Dim i As Integer, j As Integer, k As Integer, NroFila As Integer, NroColumna As Integer, recurrencia As Integer

    NroFila = ActiveCell.Row
    NroColumna = ActiveCell.Column
    UsuarioRango = Selection.Address(False, False)
    
    If NroFila = 8 Then i = 2: ElseIf NroFila > 8 Then i = (NroFila - ? + 2: End If

    j = 0
    k = 0

    For Each rng In Range(UsuarioRango).Columns
      Debug.Print vbCr & "columna " & rng.Address
          For Each cel In rng.Cells
            Debug.Print "  - celda " & cel.Address
            recuadroVerde = cel.Address
            ActiveSheet.Range(recuadroVerde).Select
            NroColumna = ActiveCell.Column
    
                If NroColumna = 19 Then
                   NroColumna = NroColumna - 17
                        k = NroColumna
                ElseIf NroColumna Like "*[13579]" Then
                   NroColumna = (NroColumna - 17) + Abs(19 - NroColumna)
                        k = NroColumna
                ElseIf NroColumna Like "*[02468]" Then
                   NroColumna = (NroColumna - 17) + Abs(19 - NroColumna)
                        k = NroColumna
                End If
            
            recurrencia = 1 / 4 * (-1) ^ NroColumna * (-2 * NroColumna + 35 * (-1) ^ NroColumna - 39)
            k = recurrencia
    
            dato = ActiveSheet.Range(recuadroVerde).Value
            txt1 = ActiveSheet.Range(recuadroVerde).Offset(0, k).Value
            fecha = ActiveSheet.Range(recuadroVerde).Offset(-i, 0).Value
            buscarv = "=VLOOKUP(RC[-2],trabajadores,2,FALSE)"
            Debug.Print txt1 & " " & fecha & " " & dato
            
            ultima = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

            With Sheets("DeCuaABase")
                .Range("A" & ultima) = txt1: .Range("B" & ultima) = CDate(fecha): .Range("C" & ultima) = buscarv: .Range("D" & ultima) = dato
            End With
            i = i + 1
            'j = 0
          Next cel
        i = 2: 'j = j + 1
    Next rng
MsgBox Format(Timer - IniciarTiempo, "00.00")
End Sub
 

Enlace a comentario
Compartir con otras webs

Esta macro te permite seleccionar cualquier número de días y empleados.

Permite selecciones discontinuas.

Para ver como funciona, abre el adjunto y ejecuta la macro respetando la selección.

Sub aBaseDeDatosSelección()
With Sheets("DeCuaABase")
   .Range("A8").CurrentRegion.Offset(1).ClearContents
   fila = 8
   For Each rango In Selection.Areas
      For y = rango.Column To rango.Columns.Count + rango.Column - 1
         For x = rango.Row To rango.Rows.Count + rango.Row - 1
            fila = fila + 1
            .Range("A" & fila) = .Cells(x, 17)
            .Range("B" & fila) = .Cells(6, y)
            .Range("C" & fila) = .Cells(x, 18)
            .Range("D" & fila) = .Cells(x, y)
         Next
      Next
   Next
End With
Application.ScreenUpdating = True
End Sub

 

deCuaABAse.xlsm

Enlace a comentario
Compartir con otras webs

Archivado

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

  • 93 ¿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
      177
    • Comentarios
      90
    • Revisiones
      27

  • Crear macros Excel

  • Mensajes

    • No va a ser necesario distinguir el tipo de proceso entre 1 y 2. Revisa el adjunto a ver si es eso lo que quieres. Function MediaAttention(mImp As Range, _ q25 As Range, q50 As Range, _ Optional q75 As Range, _ Optional q100 As Range) As Double '-- Opción 1 If q75 Is Nothing And q100 Is Nothing Then MediaAttention = q25 / q50 Exit Function End If '-- Opción 2 MediaAttention = ((0.25 * (q25 - q50)) / mImp) + _ ((0.5 * (q50 - q75)) / mImp) + _ ((0.75 * (q75 - q100)) / mImp) + _ (q100 / mImp) End Function   Media Attention Formula 1.2.xlsb
    • Gracias tomarse el tiempo de leer por responder Maestro @Antoni Adjunto el archivo con la idea a la que deseo llegar, sigo atento. Mil gracias por el tiempo y la ayuda brindada   Media Attention Formula 1.2.xlsb
    • He analizado la UDF y entiendo perfectamente lo que hace, lo que no entiendo es lo que pretendes hacer. Mejor sube un ejemplo resuelto de  como debería funcionar la UDF con los nuevos parámetros solicitados. 
    • Gracias, ya lo conseguí solucionar
    • Hola a todos Primero que nada deseo agradecer el tiempo en leer este post, Muchas Gracias. Me acerco a ustedes para pedir su ayuda para lo siguiente: Tengo una UDF, la cual tiene dos escenarios: 1.- Si Tiempo Promedio y Duración del Video son diferentes de 0, hacer el calculo 2.- Si lo anterior es igual a 0, se realiza el otro calculo por cuartiles. El detalle es que son muchas celdas a seleccionar, lo cual creo puede ser engorroso, entonces, pensando en simplificar la función, me pregunte si fuera posible: a.- Colocar 1 al principio de la función y después solo seleccionar 2 celdas correspondientes (Rango continuo o discontinuo) b.- Colocar 2 al principio de la función y después seleccionar las 5 celdas correspondientes (Rango continuo o discontinuo) Espero me puedan ayudar y/o orientar al respecto, quedo atento para cualquier duda, de antemano les agradezco cualquier ayuda brindada. Mil Gracias!! Media Attention Formula 1.1.xlsb  
  • 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.