Asignar Números correlativos de forma automática
exp/ertos, quisiera averiguar si es posible hacer lo siguiente:
Tengo dos columnas "A y B", quiero que al momento de introducir un dato en la columna "A", en la celda aydacente de la columna "B", automáticamente genere un numero correlativo que vaya del 1 en adelante, sin embargo la función que busco, es alguna forma de sincronizarlo con el reloj interno, de manera que cuando sea el 01 de Enero del 2017, automáticamente vuelva al numero 1. Desde ya agradezco su tiempo, esperando encontrar una solución o lo más cercano a una, para esta interrogante.
.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!
.
Como siempre, un placer ayudar!
Abrazo
Fer
.
