Ejecuta macro segun valor de celda

5 envíos / 0 nuevos
Último envío
MiltonCordova
Imagen de MiltonCordova
Offline
última acción: Hace 2 días 19 mins
alta: 09/06/2017 - 18:27
Puntos: 230
Ejecuta macro segun valor de celda

Saludos cordiales, estimados masters me puedne ayudar en verificar un macro que debe hacer lo siguiente:
En un rango C13:C500 al ingresar algun valor >0 se ejecuta una macro, caso contratio si el valor ingresado es 0 no debe hacer nada.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("C13:C500")) Is Nothing Then
Set Target = Range("C13:C500")
If Target.Value = 0 Then
Selection.Copy
Target.Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
end if
end if
end sub
me sale error en If Target.Value = 0 Then
Gracias por su ayuda

FernandoML
Imagen de FernandoML
Offline
última acción: Hace 4 días 2 horas
alta: 01/02/2018 - 19:53
Puntos: 195
Hola Milton:Prueba de esta

Hola Milton:

Prueba de esta manera para hacer lo que quieres. Luego nos comentas si es la solución que necesitabas.

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Col As Integer      'COLUMNA DE LOS DATOS.
    Dim FilI As Integer     'FILA DE INICIO DE LOS DATOS.
    Dim FilF As Integer     'FILA FINAL DE LOS DATOS.
   
    Col = 3     '----> COLUMNA C
    FilI = 3    'FILA DE INICIO
    FilF = 500  'FILA FINAL
    
    
    Application.ScreenUpdating = False
        If Target.Column = Col Then
            If Target.Row >= FilI And Target.Row <= FilaF Then
                If Target.Value = 0 And Target.Value <> "" Then
                    'INSERTA AQUI TU CODIGO
                End If
            End If
        End If
    Application.ScreenUpdating = True
End Sub

 

Un Saludo

FernandoML

MiltonCordova
Imagen de MiltonCordova
Offline
última acción: Hace 2 días 19 mins
alta: 09/06/2017 - 18:27
Puntos: 230
Ayuda Macro

saludos cordiales, la macro funciona para valores 0 pero cuando se ingresa un valor > 0 no funciona.

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False

    Dim Col As Integer      'COLUMNA DE LOS DATOS.
    Dim FilI As Integer     'FILA DE INICIO DE LOS DATOS.
    Dim FilF As Integer     'FILA FINAL DE LOS DATOS.
  
    Col = 3     '----> COLUMNA C
    FilI = 13    'FILA DE INICIO
    FilF = 932  'FILA FINAL
   
        If Target.Column = Col Then
            If Target.Row >= FilI And Target.Row <= FilaF Then
                If Target.Value = 0 And Target.Value <> 0 Then
                    'INSERTA AQUI TU CODIGO
              
        '---------------------------------------------------
If Not Application.Intersect(Target, Range("C13:C932")) Is Nothing Then
'SI HAY CAMBIOS SE UBICA A LA DERECHA E INSERTA CELDA EN COL. D
    Target.Offset(0, 1).Select
        Selection.Insert Shift:=xlDown
Target.Offset(0, 0).Select

'REGRESA A LA CELDA MODIFICADA Y COPIA SU CONTENIDO EN D
    Selection.Copy
    Target.Offset(0, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Target.Offset(0, 2).Select

End If
End If
End If
End If
    Application.ScreenUpdating = True
End Sub

Gracias por la ayuda

 

 

FernandoML
Imagen de FernandoML
Offline
última acción: Hace 4 días 2 horas
alta: 01/02/2018 - 19:53
Puntos: 195
Ayuda Macro

He añadido algunas lineas nuevas. Prueba si es lo que necesitabas y si necesitas alguna otra modificacion.

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Col As Integer      'COLUMNA DE LOS DATOS.
    Dim FilI As Integer     'FILA DE INICIO DE LOS DATOS.
    Dim FilF As Integer     'FILA FINAL DE LOS DATOS.
    
    'HE AÑADIDO ESTA LINEA PORQUE SI SELECCIONA UN RANGO PARA BORRAR VALORES
    'EL CODIGO DA UN ERROR DE ESTA FORMA EVITAMOS ESTE PROBLEMA.
    If InStr(1, Target.Address, ":", vbTextCompare) = 0 Then Exit Sub
    
    Col = 3         'COLUMNA C
    FilI = 3        'FILA DE INICIO
    FilF = 500      'FILA FINAL
    
    
    Application.ScreenUpdating = False
        If Target.Column = Col Then
            If Target.Row >= FilI And Target.Row <= FilF Then
                If Target.Value = 0 And Target.Value <> "" Then
                    'CODIGO PARA LOS VALORES DE 0
                    MsgBox ("VALOR ES IGUAL A CERO")
                ElseIf Target.Row > 0 Then
                    'CODIGO PARA VALORES > 0
                    MsgBox "VALOR MAYOR DE CERO"
                End If
            End If
        End If
    Application.ScreenUpdating = True
End Sub

MiltonCordova
Imagen de MiltonCordova
Offline
última acción: Hace 2 días 19 mins
alta: 09/06/2017 - 18:27
Puntos: 230
Exelente aporte, es lo que

Exelente aporte, es lo que necesito

Tema cerrado

Gracias siempre