Asignar Números correlativos de forma automática

.18/10/16

Buenas noches, Andy

Aquí va una rutina autojecutable que pondrá números consecutivos en tu columna B a menos que sea la fecha que le indiques.

Para que funcione, activa el editor de Visual Basic (presiona Alt+F11) y en el panel de la izquierda busca la hoja donde quieres que esto ocurra. Da doble click sobre ella. (Otra forma de llegar a este punto es hacer click derecho sobre la solapa de esta hoja y elegir la opción "Ver Código)

Allí pega el siguiente procedimiento:

Private Sub Worksheet_Change(ByVal Target As Range)
'---- Variables modificables:
'=== ANDY, modifica estos datos de acuerdo a tu proyecto:
Col = "A" ' celda donde está el nombre a dar a la hoja
Fechaini = "01/01/2017"
'---- fin Variables
'
'---- inicio de rutina:  
Fechaini = CDate(Fechaini)
Col = Range(Col & "1").Column
If Target.Column = Col Then
    If Date = Fechaini And Target.Offset(-1, 1) <> 1 Then
        Target.Offset(0, 1).Value = 1
    Else
        Target.Offset(0, 1).Value = Target.Offset(-1, 1) + 1
    End If
End If
End Sub

Así como está en caso de que ingresar más de un dato el dia 1/1/17 continuaría la secuencia desde 1.

Caso contrario todos los datos que ingresares ese día colocaría un 1 a su derecha. Pensé que no querrías eso.

Avísame si está OK así.

Un abrazo
Fernando

.

Hola Fernando, nuevamente agradeciendo tu ayuda tan certera, efectivamente es tal como tu dices pero hay un inconveniente y ese es que en la hoja tengo otros códigos que modifican otras columnas, con diferentes funciones, lo cual debido a mi torpeza no he sabido acomodar correctamente para que no entren en conflicto, principalmente cuando borro contenido o cuando ingresé el nuevo macro que me facilitaste el cual no he sabido hacer funcionar.
En este caso quiero ingresar un dato ( una fecha) en la columna F, para que al presionar enter me arroje el numero correlativo que te comente en la columna G. te adjunto el desorden de código que tengo y una captura de mi proyecto. Saludos Cordiales y perdón por mi torpeza pero soy un principiante en esto.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then Target = UCase(Target)
If Target.Column = 9 Then Target = UCase(Target)
If Target.Column = 10 Then Target = UCase(Target)
'---- Variables modificables:
ElRango = "b8:b1500" ' Target donde está el nombre a dar a la hoja
'---- fin Variables
'
'---- inicio de rutina:
Set isect = Application.Intersect(Range(ElRango), Target)
If Not isect Is Nothing Then
    If Len(Target) = 9 Then
        Target = Left(Target, 2) & "." & Mid(Target, 3, 3) & "." & Mid(Target, 6, 3) & "-" & Right(Target, 1)
    ElseIf Len(Target) = 8 Then
        Target = Left(Target, 1) & "." & Mid(Target, 2, 3) & "." & Mid(Target, 5, 3) & "-" & Right(Target, 1)
    End If
End If
Set isect = Nothing
'---- Variables modificables:
Col = "G" ' celda donde está el nombre a dar a la hoja
Fechaini = "01/01/2017"
'---- fin Variables
'
'---- inicio de rutina:  
Fechaini = CDate(Fechaini)
Col = Range(Col & "1").Column
If Target.Column = Col Then
    If Date = Fechaini And Target.Offset(-1, 1) <> 1 Then
        Target.Offset(0, 1).Value = 1
    Else
        Target.Offset(0, 1).Value = Target.Offset(-1, 1) + 1
    End If
End If
End Sub

.

Hola, Andy

Efectivamente, estaban conviviendo distintas instrucciones que conflictuaban a VBA

Entonces modifiqué el código para que analice qué hacer en cada columna, quedando más ordenado.

La rutina considera si el cambio se hace debajo de los títulos (hay variable nueva para que le indiques en qué linea están. Caso contrario, o si la celda pasa a estar vacía, sale de la rutina.

Es decir que según la columna donde se haga el cambio hará una cosa u otra.

Verás en la estructura Select Case, qué hace en qué columna(s).

Reemplaza el código anterior en esa hoja por el siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
'---- Variables modificables:
FilaTit = 9 ' Fila donde están los títulos del cuadro
Fechaini = "01/01/2017"
'---- fin Variables
'
'---- inicio de rutina:
If Target.Row < FilaTit Or IsEmpty(Target) Then
    Exit Sub
Else
    Fechaini = CDate(Fechaini)
    Select Case Target.Column
'  
    Case 5, 9, 10 'columnas a convertir a MAYUSCULAS  
        If Len(Target) Then Target.Value = UCase(Target.Value)
'  
    Case 2 'Columna donde se ingresa el R.U.N.  
        If Len(Target) = 9 Then
            Target = Left(Target, 2) & "." & Mid(Target, 3, 3) & "." & Mid(Target, 6, 3) & "-" & Right(Target, 1)
        ElseIf Len(Target) = 8 Then
            Target = Left(Target, 1) & "." & Mid(Target, 2, 3) & "." & Mid(Target, 5, 3) & "-" & Right(Target, 1)
        End If
'  
    Case 7 ' columna donde se ingresa la fecha  
        If Date = Fechaini And Target.Offset(-1, 1) <> 1 Then
            Target.Offset(0, 1).Value = 1
        Else
            Target.Offset(0, 1).Value = Target.Offset(-1, 1) + 1
        End If
    End Select
End If
End Sub

Espero que ahora sí te funcione OK. HAsta donde probé lo hacía

Un abrazo

Fer

.

Muchas gracias Fernando, sos un capo tremendo!, me funciona todo de maravilla, solo quiero pedirte el ultimo favor, y es una excepción para que el macro de la fecha pueda trabajar cuando esa columna este protegida y bloqueada, la idea es forzar el uso del correlativo automático, pero a la vez poder corregir fácil si fuera necesario, y la opción de proteger la hoja me parece la más sencilla, Muchísimas gracias.

.

Ok, Andy

Esta versión quita la protección de la hoja para hacer los cambios restituyendola después como solicitaste:

Private Sub Worksheet_Change(ByVal Target As Range)
'---- Variables modificables:
FilaTit = 9 ' Fila donde están los títulos del cuadro
Fechaini = "01/01/2017"
'---- fin Variables
'
'---- inicio de rutina:  
If Target.Row <= FilaTit Or IsEmpty(Target) Then
    Exit Sub
Else
    Fechaini = CDate(Fechaini)
    Select Case Target.Column
    ActiveSheet.Unprotect
'
    Case 5, 9, 10 'columnas a convertir a MAYUSCULAS  
        If Len(Target) Then Target.Value = UCase(Target.Value)
'  
    Case 2 'Columna donde se ingresa el R.U.N.  
        If Len(Target) = 9 Then
            Target = Left(Target, 2) & "." & Mid(Target, 3, 3) & "." & Mid(Target, 6, 3) & "-" & Right(Target, 1)
        ElseIf Len(Target) = 8 Then
            Target = Left(Target, 1) & "." & Mid(Target, 2, 3) & "." & Mid(Target, 5, 3) & "-" & Right(Target, 1)
        End If
'  
    Case 7 ' columna donde se ingresa la fecha  
        If Date = Fechaini And Target.Offset(-1, 1) <> 1 Then
            Target.Offset(0, 1).Value = 1
        Else
            Target.Offset(0, 1).Value = Target.Offset(-1, 1) + 1
        End If
    ActiveSheet.Protect
    End Select
End If
End Sub

Espero haberte interpretado correctamente.

Saludos

Fer

.

¡Muchas Gracias!, todo ok, me quedo perfecto, te agradezco demasiado por tu ayuda.
Que tengas un excelente resto semana.

Saludos Cordiales!