¿Se podría ejecutar la macro cuando sepa que los datos son correctos?

Hace un tiempo me ayudaste con esta macro

Yo meto datos en una hoja y me hace un calculo mensual y anual en otra hoja. La macro funciona bien y hace su función a la perfección, a medida que voy introduciendo datos me los va añadiendo y sumando, pero vengo notando algo.

Si en la primera celda donde introduzco un valor pongo por ejemplo "20", y luego lo borro y coloco "21" la suma en la siguiente hoja me la borra entera, tanto el valor mensual como el anual.

¿Se podría ejecutar esta macro solo cuando yo le diga?

Muchas gracias, Un saludo

Private Sub Worksheet_Change(ByVal Target As Range)
'actualiza los acumuladores en la siguiente hoja
'
If Not Intersect(Target, Range("K:X")) Is Nothing Then
If Target.Row < 9 Then Exit Sub
If Target.Count > 10 Then Exit Sub
'
Set H1 = ActiveSheet
fila = Target.Cells(1, 1).Row
col = Target.Cells(1, 1).Column
valor = Val(Cells(fila, col).Value)
Set fec1 = H1.Range("K6")
Set h2 = Sheets("NOVIEMBRE")
Set fec2 = h2.Cells(fila, "CS") 'fecha de captura
'
If fec2.Value = "" Or Not IsDate(fec2.Value) Then
fec2.Value = fec1.Value
End If
'
año1 = Year(fec1.Value)
año2 = Year(fec2.Value)
mes1 = Month(fec1.Value)
mes2 = Month(fec2.Value)
dia1 = Day(fec1.Value)
dia2 = Day(fec2.Value)
If año1 <> año2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = valor 'mes
h2.Cells(fila, "U").Value = valor 'año
Else
If mes1 <> mes2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = valor 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value + valor 'año
Else
If dia1 <> dia2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = h2.Cells(fila, "O").Value + valor 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value + valor 'año
Else
h2.Cells(fila, "J").Value = H1.Cells(fila, "AH") 'dia
h2.Cells(fila, "O").Value = h2.Cells(fila, "O").Value - h2.Cells(fila, "CR") + H1.Cells(fila, "AH") 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value - h2.Cells(fila, "CR") + H1.Cells(fila, "AH") 'año
End If
End If
End If
fec2.Value = H1.Range("K6")
h2.Cells(fila, "CR") = H1.Cells(fila, "AH")
End If
End Sub

1 Respuesta

Respuesta
1

Puede ser así:

Private Sub Worksheet_Change(ByVal Target As Range)
'actualiza los acumuladores en la siguiente hoja
'
If Not Intersect(Target, Range("K:X")) Is Nothing Then
If Target.Row < 9 Then Exit Sub
If Target.Count > 10 Then Exit Sub
'
res = MsgBox("Deseas actualizar", vbQuestion + vbYesNo)
If res = vbNo Then Exit Sub
'
Set H1 = ActiveSheet
fila = Target.Cells(1, 1).Row
col = Target.Cells(1, 1).Column
valor = Val(Cells(fila, col).Value)
Set fec1 = H1.Range("K6")
Set h2 = Sheets("NOVIEMBRE")
Set fec2 = h2.Cells(fila, "CS") 'fecha de captura
'
If fec2.Value = "" Or Not IsDate(fec2.Value) Then
fec2.Value = fec1.Value
End If
'
año1 = Year(fec1.Value)
año2 = Year(fec2.Value)
mes1 = Month(fec1.Value)
mes2 = Month(fec2.Value)
dia1 = Day(fec1.Value)
dia2 = Day(fec2.Value)
If año1 <> año2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = valor 'mes
h2.Cells(fila, "U").Value = valor 'año
Else
If mes1 <> mes2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = valor 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value + valor 'año
Else
If dia1 <> dia2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = h2.Cells(fila, "O").Value + valor 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value + valor 'año
Else
H2. Cells(fila, "J").Value = H1. Cells(fila, "AH") 'dia
h2. Cells(fila, "O").Value = h2. Cells(fila, "O").Value - h2.Cells(fila, "CR") + H1. Cells(fila, "AH") 'mes
h2. Cells(fila, "U").Value = h2. Cells(fila, "U").Value - h2.Cells(fila, "CR") + H1. Cells(fila, "AH") 'año
End If
End If
End If
fec2.Value = H1.Range("K6")
h2.Cells(fila, "CR") = H1.Cells(fila, "AH")
End If
End Sub

[sal u dos

Muchas gracias por la contestación, me refería a eso más o menos pero que, en vez de que me pregunte cada vez que relleno una celda (ya que son 38 celdas las que he de rellenar) que hubiera un botón de actualizar cuando las he rellenado y comprobado todas.

Un saludo

Revisando las respuestas, en alguna ocasión te pregunté si lo querías en un botón o en automático, y respondiste que en automático.

Si lo quieres en un botón, selecciona la celda que quieras calcular y en el botón pon el siguiente código:

Sub un_proceso()
'actualiza los acumuladores en la siguiente hoja
'
Set objetivo = ActiveCell
If Not Intersect(objetivo, Range("K:X")) Is Nothing Then
If objetivo.Row < 9 Then Exit Sub
If objetivo.Count > 10 Then Exit Sub
'
'res = MsgBox("Deseas actualizar", vbQuestion + vbYesNo)
'If res = vbNo Then Exit Sub
'
Set H1 = ActiveSheet
fila = objetivo.Cells(1, 1).Row
col = objetivo.Cells(1, 1).Column
valor = Val(Cells(fila, col).Value)
Set fec1 = H1.Range("K6")
Set h2 = Sheets("NOVIEMBRE")
Set fec2 = h2.Cells(fila, "CS") 'fecha de captura
'
If fec2.Value = "" Or Not IsDate(fec2.Value) Then
fec2.Value = fec1.Value
End If
'
año1 = Year(fec1.Value)
año2 = Year(fec2.Value)
mes1 = Month(fec1.Value)
mes2 = Month(fec2.Value)
dia1 = Day(fec1.Value)
dia2 = Day(fec2.Value)
If año1 <> año2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = valor 'mes
h2.Cells(fila, "U").Value = valor 'año
Else
If mes1 <> mes2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = valor 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value + valor 'año
Else
If dia1 <> dia2 Then
h2.Cells(fila, "J").Value = valor 'dia
h2.Cells(fila, "O").Value = h2.Cells(fila, "O").Value + valor 'mes
h2.Cells(fila, "U").Value = h2.Cells(fila, "U").Value + valor 'año
Else
H2. Cells(fila, "J").Value = H1. Cells(fila, "AH") 'dia
h2. Cells(fila, "O").Value = h2. Cells(fila, "O").Value - h2.Cells(fila, "CR") + H1. Cells(fila, "AH") 'mes
h2. Cells(fila, "U").Value = h2. Cells(fila, "U").Value - h2.Cells(fila, "CR") + H1. Cells(fila, "AH") 'año
End If
End If
End If
fec2.Value = H1.Range("K6")
h2.Cells(fila, "CR") = H1.Cells(fila, "AH")
End If
End Sub

En este caso tienes que borrar la macro del evento de la hoja

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas