De modelo CUADRANTE de TURNOS a modelo BASE de DATOS

[patriciomates]

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.

deCuaABAse.xlsm

[Antoni]

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

 

[patriciomates]

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!

[patriciomates]

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:

Pasar la mitad de los trabajadores de 1 dia: 

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

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

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.

 

[patriciomates]

 

VOY A INTENTARLO y si veo que no le saco punta os pido intervención.

[patriciomates]

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

[patriciomates]

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
 

[patriciomates]

Ya está solo falta asignar antes de entrar al doble for  el valor de la posición de la selección a la i

deCuaABAse.xlsm

[Antoni]

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

[patriciomates]

YESSSSSSSSSS funciona de miedooooooooo, qué feliz estoy

[patriciomates]

Funciona muy bien he hecho una lectura por consola ... muchas gracias forever Antoni my God