Macros excel
Buenos días, tengo una macro que lo que hace es que al darle doble click a por ejemplo la celda "B5" se sume una unidad en "C5" y así susecibamente. Esto lo hago para contar grandes volúmenes de información que tengo que procesar. Adjunto el código:
*****
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call Contador
End Sub
*****
Sub Contador()
Dim i As Integer
For i = 5 To 50
If ActiveCell = Range("b" & i) Then
Range("c" & i) = Range("c" & i) + 1
Range("C5:C50").Interior.ColorIndex = xlNone
Range("C" & i).Interior.ColorIndex = 4
Range("a1").Activate
End If
Next
End Sub
*****
Este código funciona perfectamente pero ahora necesito expandir más su función porque tengo que procesar mucha más información y tiene que afectar muchas columnas y filas. La idea mía es que si yo le doy doble click a "C5" se sume "C5" + 1 y así con un rango que va desde "C5:L19" pero este código no funciona. ¿Alguna forma de hacer esto de otra manera o modificando el código actual? Gracias de antemano.
*****
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call Contador
End Sub
*****
Sub Contador()
Dim i As Integer
For i = 5 To 50
If ActiveCell = Range("b" & i) Then
Range("c" & i) = Range("c" & i) + 1
Range("C5:C50").Interior.ColorIndex = xlNone
Range("C" & i).Interior.ColorIndex = 4
Range("a1").Activate
End If
Next
End Sub
*****
Este código funciona perfectamente pero ahora necesito expandir más su función porque tengo que procesar mucha más información y tiene que afectar muchas columnas y filas. La idea mía es que si yo le doy doble click a "C5" se sume "C5" + 1 y así con un rango que va desde "C5:L19" pero este código no funciona. ¿Alguna forma de hacer esto de otra manera o modificando el código actual? Gracias de antemano.
1 Respuesta
Respuesta de tavopz
1
Si la idea es sólo aumentar el valor, puedes reemplazar el primer código que me enviaste por este:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C5:L19")) Is Nothing Then
Target.Value = Target + 1
Cells(Target.Row + 1, Target.Column).Select
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("C5:L19")) Is Nothing Then
Target.Value = Target + 1
Cells(Target.Row + 1, Target.Column).Select
End If
End Sub
