Excel - Macros de buscar y sumar

 
Vista:
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 12/01/2020 20:50:25
Alguien me puede ayudar con este libro para poder con una macros de buscar en una hoja y que vaya sumando automaticamente en otra hoja como si fuera la formula de buscarv, pero que en la misma celda se vayan sumando varios resultados. Seria que de la hoja llamada plantilla de repaso mandara la información a otras hojas dependiendo del operario y del turno de trabajo.
Gracias y un saludo
jaime
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 3.988
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por Antoni Masana (1392 intervenciones) el 13/01/2020 15:04:13
Creo que ya hemos hablado antes y realice una macro para hacer una copia de la hoja llamada plantilla de repaso.
Lo que se me ocurre para evitar que se duplique la información es hacer el calculo antes de la copia en la misma macro.
Creo haber visto otro post para ampliar la copia de backup, podemos hacerlo todo junto.
Necesito saber:
- Que se tiene que sumar.
- Donde se pone el resultado.
- Es aculmulativo, es decir donde se pone el resultado de la suma reemplaza al contenido anterior o lo suma.

Busco el otro post

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 13/01/2020 19:47:02
Buenas Antoni

Gracias por tu ayuda,
La idea es +- como tu dices, seria que al rellenar la "plantilla de repaso" buscara en que turno esta el operario que esta en la columna L, y que busque las columnas D, F y H de la "plantilla de repaso" y las peque en las columnas dependiendo del turno de trabajo en las columnas C,D y E, y que si se repite el operario en otro dia o en el mismo dia trabajo las sume a las que ya tiene tanto en la columna C,D y E, a tener en cuenta que en la plantilla de repaso las columnas F y H hacen referencia a un código habría que decirle a la macros que por cada código seria = a 1, ósea que un código es igual a una falta. Tambien si se puede habría que tener en cuenta que al cambiar de mes ya no son las mismas columnas en las plantillas de turnos. QUE LIO

un saludo y gracias
Jaime
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 3.988
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por Antoni Masana (1392 intervenciones) el 13/01/2020 21:34:30
Vamos a ver si lo entiendo:

La macro tiene que recorrer la hoja Plantilla Repaso desde la fila 8 hasta la 33

Tratamos el primero, la fila 8.
Coge el valor de la columna L que es 2675541

Mira el valor de la columna K que es el turno NOCHE

Va a la hoja TURNO NOCHE
Busca en la columna A desde la fila 7 hasta que en la columna B encuentre la palabra TOTALES el valor 2675541. Y lo encuentra en la fila 7

Volvemos a la hoja Plantilla Repaso para ver qué mes hay la columna A
Toma los valores de las celdas D8, F8 y H8,

Va a la hoja TURNO NOCHE
Según el mes las columnas a escribir son:
- para enero C, D y E
- para febrero F, G y H
- etc.

y en estas tres celdas sumamos los valores que en este caso seria
- en la hoja TURNO NOCHE celda C7 se suma el valor de la hoja Plantilla Repaso celda D8
- en la hoja TURNO NOCHE celda D7 se suma el valor de la hoja Plantilla Repaso celda F8
- en la hoja TURNO NOCHE celda E7 se suma el valor de la hoja Plantilla Repaso celda H8

Y pasa a tratar la fila 9 de la hoja Plantilla Repaso


Hay una cosa que no entiendo: en la hoja de turnos hay tres grupos de PRODUCTOR:

- PREPARACIÓN - M - SPP
- SPD
- PREPARACIÓN -E-

El código a buscar de la columna D de la hoja Plantilla Repaso puede estar en los tres o solo en uno de ellos, no se que son y la búsqueda hasta encontrar TOTALES es porque es la referencia que me indica el final, si tuviese que buscar en el primer bloque me padaria al encontrar la celda vacía.
¿Y todo esto porque? por si hay un código que no encuentra no se lea el millón y pico de filas y de un error.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 13/01/2020 21:47:33
Gracias Antoni
Tu primera anotación seria lo que comentas salvo una modificación.

Va a la hoja TURNO NOCHE
Busca en la columna A desde la fila 7 hasta que en la columna B encuentre la palabra TOTALES el valor de la celda L8.

pero seria lo que te pongo a continuación

Va a la hoja de TURNO NOCHE
Busca en la columna A desde la fila 7 hasta la fila 170

y refenente a tu segunda anotacion

El codigo a buscar esta en la columna L desde la fila 8 hasta la 33 de la plantillla de repaso, que segun su numero de productor puede estar en una de las 3 hojas que pone TURNO MAÑANA, TURNO NOCHE Y TURNO TARDE.

Los de los tres grupos no hagas caso se podria quitar y dejar todos los operarios seguidos. desde la fila 7 hasta las 170 +-

un saludo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 3.988
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por Antoni Masana (1392 intervenciones) el 14/01/2020 16:10:18
Aqui esta la macro junto a la de la copia de BACKUP:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Option Explicit
 
Sub Copia_de_Backup()
    Dim Valor_D As Long, Mes As Byte, Turno As String, _
        Valor_F As Long, Product As Long, Fila_Out As Long, _
        Valor_H As Long, SW_Error As Boolean
 
    Dim Fila As Long, Datos As Boolean
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.CutCopyMode = False
 
    Sheets("plantilla repaso").Select
 
    ' ---&--- Cuenta cuantas filas tiene que copiar
 
    Datos = False
    For Fila = 8 To 33
       If Cells(Fila, "A") <> "" Then Datos = True
    Next
 
    ' ---&--- Si esta vacio no hay que copiar
 
    If Not Datos Then Exit Sub
 
    ' ---&--- Realiza la suma de datos
 
    For Fila = 8 To 33
 
        ' ---&--- Lee los datos
 
        Valor_D = Cells(Fila, "D")
        Valor_F = Cells(Fila, "F")
        Valor_H = Cells(Fila, "H")
        Mes = Month(Cells(Fila, "A")) * 3
        Turno = Cells(Fila, "K")
        Product = Cells(Fila, "L")
 
        ' ---&--- Cambia a la hoja de TURNO, Controla que el turno este mal escrito
 
        On Error GoTo Turno_Desconocido
        SW_Error = True: Sheets("TURNO " & Turno).Select
        SW_Error = False
        On Error GoTo 0
 
        ' ---&--- Busca la fila del producto
 
        Fila_Out = 7
        While Left(Cells(Fila_Out, "B"), 7) <> "TOTALES" And _
                   Cells(Fila_Out, "A") <> Product And Fila_Out < 2 ^ 9
            Fila_Out = Fila_Out + 1
        Wend
 
        ' ---&--- Si encontro el producto guarda los datos
 
        If Cells(Fila_Out, "A") = Product Then
           Cells(Fila_Out, Mes + 0) = Cells(Fila_Out, Mes + 0) + Valor_D
           Cells(Fila_Out, Mes + 1) = Cells(Fila_Out, Mes + 1) + Valor_F
           Cells(Fila_Out, Mes + 2) = Cells(Fila_Out, Mes + 2) + Valor_H
        Else
           MsgBox "No he localizado el productor: " & Product & " en el turno " & Turno
        End If
 
 
Turno_Desconocido:
        ' ---&--- Si no encontro la hoja del producto
 
        If SW_Error Then
           MsgBox "En la fila " & Fila & " el turno: " & Turno & _
                  " no lo puedo identificar.", vbCritical + vbOKOnly, "ERROR TURNO"
        End If
        Sheets("plantilla repaso").Select
    Next
 
    Exit Sub   ' <---------------------------------- Quitar para que realice la copia ( PARA PRUEBAS )
 
    ' ---&--- Copia el rango de filas
 
    Range("A8:L33").Select
    Selection.Copy
 
    Sheets("COPIAS").Select
 
    ' ---&--- Busca la primera celda vacia donde copiar
 
    Fila = 8
    While Cells(Fila, "L") <> "": Fila = Fila + 26: Wend
 
    ' ---&--- Copia y se posiciona
 
    ActiveSheet.Unprotect "sisi"
    Range("A" & Fila).Select: ActiveSheet.Paste
    Range("A" & Fila).Select
    ActiveSheet.Protect "sisi"
 
    Application.CutCopyMode = False
 
    Sheets("plantilla repaso").Select
 
    ' ---&--- Limpia el rango copiado
 
    Range("A8:L33").Select: Selection.ClearContents
    Range("A8").Select
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.CutCopyMode = False
End Sub

Hay un par de cosas que no estoy seguro de haber hecho bien:

1.- Si en el origen esta en blanco en el destino sale un CERO ¿Es correcto?
2.- En el origen las columnas D, F y H son códigos ¿Se debe sumar a lo que tenga el destino o reemplazarlo? Ahora lo suma pero no le veo la lógica de sumar códigos

En la lÍnea 78 del código hay un EXIT SUB fácil de identificar que sirve para probar el primer trozo de la macro el resto ya esta probado.


Dale un vistazo, lo pruebas y me dices.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 14/01/2020 20:42:03
Buenas Antoni
La estoy probando en casa y parece que va muy bien, es lo que buscaba, referente a los ceros tambien esta bien, luego pondre un formato condicional que no se vean los ceros y solucionado, y referente a la columna D esta bien ya que va sumando , luego las columnas F y H hacen referencia a unos códigos de productos del almacen, pero seria que en lugar de volcar el código que volcara por cada código que hay en la columna que ponga 1 y que fuera tambien sumando. Ya que es una plantilla de repaso de pedidos y cuando ponemos un código es por que se le a repasado un pedido y se a equivocado en algún código.por lo tanto es un sumatorio de cuantas veces se equivoca.

Gracias Antoni por tu ayuda eres una pasada.

un saludo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 3.988
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por Antoni Masana (1392 intervenciones) el 15/01/2020 15:07:29
Desplazo los datos de las columnas F y H a G e I respectivamente
En el destino no suma si la variable tiene un valor 0

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Option Explicit
 
Sub Copia_de_Backup()
    Dim Valor_D As Long, Mes As Byte, Turno As String, _
        Valor_G As Long, Product As Long, Fila_Out As Long, _
        Valor_I As Long, SW_Error As Boolean
 
    Dim Fila As Long, Datos As Boolean
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.CutCopyMode = False
 
    Sheets("plantilla repaso").Select
 
    ' ---&--- Cuenta cuantas filas tiene que copiar
 
    Datos = False
    For Fila = 8 To 33
       If Cells(Fila, "A") <> "" Then Datos = True
    Next
 
    ' ---&--- Si esta vacio no hay que copiar
 
    If Not Datos Then Exit Sub
 
    ' ---&--- Realiza la suma de datos
 
    For Fila = 8 To 33
 
        ' ---&--- Lee los datos
 
        Valor_D = Cells(Fila, "D")
        Valor_G = Cells(Fila, "G")
        Valor_I = Cells(Fila, "I")
        Mes = Month(Cells(Fila, "A")) * 3
        Turno = Cells(Fila, "K")
        Product = Cells(Fila, "L")
 
        ' ---&--- Cambia a la hoja de TURNO, Controla que el turno este mal escrito
 
        On Error GoTo Turno_Desconocido
        SW_Error = True: Sheets("TURNO " & Turno).Select
        SW_Error = False
        On Error GoTo 0
 
        ' ---&--- Busca la fila del producto
 
        Fila_Out = 7
        While Left(Cells(Fila_Out, "B"), 7) <> "TOTALES" And _
                   Cells(Fila_Out, "A") <> Product And Fila_Out < 2 ^ 9
            Fila_Out = Fila_Out + 1
        Wend
 
        ' ---&--- Si encontro el producto guarda los datos
 
        If Cells(Fila_Out, "A") = Product Then
           IF Valor_D <> 0 Then Cells(Fila_Out, Mes + 0) = Cells(Fila_Out, Mes + 0) + Valor_D
           IF Valor_G <> 0 Then Cells(Fila_Out, Mes + 1) = Cells(Fila_Out, Mes + 1) + Valor_G
           IF Valor_I <> 0 Then Cells(Fila_Out, Mes + 2) = Cells(Fila_Out, Mes + 2) + Valor_I
        Else
           MsgBox "No he localizado el productor: " & Product & " en el turno " & Turno
        End If
 
 
Turno_Desconocido:
        ' ---&--- Si no encontro la hoja del producto
 
        If SW_Error Then
           MsgBox "En la fila " & Fila & " el turno: " & Turno & _
                  " no lo puedo identificar.", vbCritical + vbOKOnly, "ERROR TURNO"
        End If
        Sheets("plantilla repaso").Select
    Next
 
    Exit Sub   ' <---------------------------------- Quitar para que realice la copia ( PARA PRUEBAS )
 
    ' ---&--- Copia el rango de filas
 
    Range("A8:L33").Select
    Selection.Copy
 
    Sheets("COPIAS").Select
 
    ' ---&--- Busca la primera celda vacia donde copiar
 
    Fila = 8
    While Cells(Fila, "L") <> "": Fila = Fila + 26: Wend
 
    ' ---&--- Copia y se posiciona
 
    ActiveSheet.Unprotect "sisi"
    Range("A" & Fila).Select: ActiveSheet.Paste
    Range("A" & Fila).Select
    ActiveSheet.Protect "sisi"
 
    Application.CutCopyMode = False
 
    Sheets("plantilla repaso").Select
 
    ' ---&--- Limpia el rango copiado
 
    Range("A8:L33").Select: Selection.ClearContents
    Range("A8").Select
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.CutCopyMode = False
End Sub


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 15/01/2020 16:45:46
Buenas Antoni.

Funciona de maravilla, la modificación que has echo perfecto eres una pasada, muchas gracias por todo, eres muy amable.

un saludo
Jaime
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 17/01/2020 16:52:08
Buenas Antoni

Perdona por las molestias pero me he dado cuenta que si no relleno hasta el final la hoja "plantilla de repaso" da error de depuración, se podría modificar que si solo relleno una fila tambien funcione. Te adjunto archivo para que lo ves.

un saludo
Jaime
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 3.988
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por Antoni Masana (1392 intervenciones) el 17/01/2020 20:15:02
Ya esta arreglado:

Le puesto que si el campo Turno esta vacio salte a la siguiente línea.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub Copia_de_Backup()
    Dim Valor_D As Long, Mes As Byte, Turno As String, _
        Valor_G As Long, Product As Long, Fila_Out As Long, _
        Valor_I As Long, SW_Error As Boolean
 
    Dim Fila As Long, Datos As Boolean
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.CutCopyMode = False
 
    Sheets("plantilla repaso").Select
 
    ' ---&--- Cuenta cuantas filas tiene que copiar
 
    Datos = False
    For Fila = 8 To 33
       If Cells(Fila, "A") <> "" Then Datos = True
    Next
 
    ' ---&--- Si esta vacio no hay que copiar
 
    If Not Datos Then Exit Sub
 
    ' ---&--- Realiza la suma de datos
 
    For Fila = 8 To 33
 
        ' ---&--- Lee los datos
 
        Valor_D = Cells(Fila, "D")
        Valor_G = Cells(Fila, "G")
        Valor_I = Cells(Fila, "I")
        Mes = Month(Cells(Fila, "A")) * 3
        Turno = Cells(Fila, "K")
        Product = Cells(Fila, "L")
 
        If Not Turno = Empty Then
 
            ' ---&--- Cambia a la hoja de TURNO, Controla que el turno este mal escrito
 
            On Error GoTo Turno_Desconocido
            SW_Error = True: Sheets("TURNO " & Turno).Select
            SW_Error = False
            On Error GoTo 0
 
            ' ---&--- Busca la fila del producto
 
            Fila_Out = 7
            While Left(Cells(Fila_Out, "B"), 7) <> "TOTALES" And _
                       Cells(Fila_Out, "A") <> Product And Fila_Out < 2 ^ 9
                Fila_Out = Fila_Out + 1
            Wend
 
            ' ---&--- Si encontro el producto guarda los datos
 
            If Cells(Fila_Out, "A") = Product Then
                If Valor_D <> 0 Then Cells(Fila_Out, Mes + 0) = Cells(Fila_Out, Mes + 0) + Valor_D
                If Valor_G <> 0 Then Cells(Fila_Out, Mes + 1) = Cells(Fila_Out, Mes + 1) + Valor_G
                If Valor_I <> 0 Then Cells(Fila_Out, Mes + 2) = Cells(Fila_Out, Mes + 2) + Valor_I
            Else
                MsgBox "No he localizado el productor: " & Product & " en el turno " & Turno
            End If
        End If
 
 
Turno_Desconocido:
        ' ---&--- Si no encontro la hoja del producto
 
        If SW_Error Then
           MsgBox "En la fila " & Fila & " el turno: " & Turno & _
                  " no lo puedo identificar.", vbCritical + vbOKOnly, "ERROR TURNO"
        End If
        Sheets("plantilla repaso").Select
    Next
 
      ' <---------------------------------- Quitar para que realice la copia ( PARA PRUEBAS )
 
    ' ---&--- Copia el rango de filas
 
    Range("A8:L33").Select
    Selection.Copy
 
    Sheets("COPIAS").Select
 
    ' ---&--- Busca la primera celda vacia donde copiar
 
    Fila = 8
    While Cells(Fila, "L") <> "": Fila = Fila + 26: Wend
 
    ' ---&--- Copia y se posiciona
 
    ActiveSheet.Unprotect "sisi"
    Range("A" & Fila).Select: ActiveSheet.Paste
    Range("A" & Fila).Select
    ActiveSheet.Protect "sisi"
 
    Application.CutCopyMode = False
 
    Sheets("plantilla repaso").Select
 
    ' ---&--- Limpia el rango copiado
 
    Range("A8:L33").Select: Selection.ClearContents
    Range("A8").Select
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.CutCopyMode = False
End Sub


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 110
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macros de buscar y sumar

Publicado por JAIME (39 intervenciones) el 17/01/2020 21:03:27
Gracias Antoni.

Perdón por las prisas, ahora SI.

un saludo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar