Jump to content

De modelo CUADRANTE de TURNOS a modelo BASE de DATOS


Go to solution Solved by Antoni,

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

Link to comment
Share on other sites

  • Solution

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

 

Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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
 

Link to comment
Share on other sites

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

Edited by Antoni
Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
×
×
  • Create New...

Important Information

Privacy Policy