Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Autonumericos en Excel desde Formulario al hacer click en Boton

DREAMERMX

Recommended Posts

DREAMERMX Principiante

DREAMERMX

publicado
publicado

Hola a todos!

Tengo un formulario en VBA para registrar datos en una tabla de excel. Lo que necesito, es que cada vez que se hace click en el botón "Registrar" de mi formulario, en la primera celda de cada fila vaya generando algo así como un Autonumerico con formato "REG-0001" y al volver a cargar datos en el formulario y al apretar nuevamente dicho botón, lo haga con el código "REG-0002" ...03,04 y así sucesivamente....

¿Alguien me puede guiar? ¡Gracias!

Antoni Veterano

Antoni

publicado
publicado

Suponiendo que el correlativo empiece en A2: 

If Range("A2") = "" Then
   Range("A2") = "REG-0001"
Else
   Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = _
      "REG-" & Format(Right(Range("A" & Rows.Count).End(xlUp), 4) + 1, "0000")
End If

Otra vía podría ser usando el formato de la celda: 

   With Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
      .Value = WorksheetFunction.Max(Columns("A")) + 1
      .NumberFormat = """REG-"" 0000"
   End With

 

DREAMERMX Principiante

DREAMERMX

publicado
  • Autor
publicado

Hola Antoni, muchísimas gracias por tu código. Sabrás disculpar mi ignorancia, pero no sé mucho de programación, me doy un poco de maña nomas, por ello te consulto: Ese código, va en el área Módulo? ¿O directamente en el evento clic del botón?
Gracias
DreamerMX

Antoni Veterano

Antoni

publicado
publicado
Hace 2 horas, DREAMERMX dijo:

Hola Antoni, muchísimas gracias por tu código. Sabrás disculpar mi ignorancia, pero no sé mucho de programación, me doy un poco de maña nomas, por ello te consulto: Ese código, va en el área Módulo? ¿O directamente en el evento clic del botón?
Gracias
DreamerMX

En el evento click del botón.

DREAMERMX Principiante

DREAMERMX

publicado
  • Autor
publicado

Hola Antoni, gracias por tu respuesta. Lamentablemente no he tenido éxito.
Como la primera celda a insertar dicho autonumerico es la A5, he reemplazado A2 por A5, supongo esta bien.

El problema es que lo "Inyecta" sólo una vez al presionar el botón registrar (en donde está el código) pero recién lo hace al cerrar TODO el Formulario, por ende, si no lo cierro y sigo registrando (Pues tiene una función para limpiar) otros valores no lo hace (lo deja en blanco)...Y si cierro y abro constantemente tras Registrar, "inyecta" siempre el mismo valor: REG-001 Te dejo mi código a ver si encuentras mi error?
  

Private Sub CommandButton1_Click()
'Selecciona la Hoja "FORMULARIO"
Sheets("FORMULARIO").Select

'Selecciona la celda "B5" la Hoja "FORMULARIO" para insertar a partir de ahí en toda la fila
Range("B5").EntireRow.Insert

'Selecciona la celda "B5" la Hoja "FORMULARIO" para insertar a partir de ahí los valores ingresados en el Form

Range("B5") = NroN.Value
Range("C5") = Nombre.Value
Range("D5") = ADisp.Value
Range("E5") = ADNro.Value
Range("F5") = Dep.Value
Range("G5") = Us.Value
Range("H5") = FechaF.Value
Range("I5") = LugarF.Value
Range("J5") = Vi.Value
Range("K5") = Ca.Value
Range("L5") = Rve.Value
Range("M5") = R13.Value
Range("N5") = Uf.Value
Range("O5") = Ipe.Value
Range("P5") = Dep2.Value
Range("Q5") = AP.Value
Range("R5") = Observaciones.Value

MsgBox "Los datos se han registrado con exito!"

'Limpia el formulario de entrada de datos

NroN= Empty
Nombre = Empty
ADisp = Empty
ADNro = Empty
Dep = Empty
Us = Empty
FechaF = Empty
LugarF = Empty
Vi = Empty
Ca = Empty
RVe = Empty
R13 = Empty
Uf = Empty
Ipe = Empty
Dep2 = Empty
AP = Empty
Observaciones = Empty

End Sub

Private Sub CommandButton2_Click()

'Asigna la Macro creada "SiNo"
SiNo


'Genera Autonumericos en la Celda
If Range("A5") = "" Then
   Range("A5") = "REG-0001"
Else
   Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = _
     "REG-" & Format(Right(Range("A" & Rows.Count).End(xlUp), 4) + 1, "0000")
End If
'Genera Autonumericos en la Celda

End Sub

 

Desde ya, muchas gracias por tu atención. Saludos, Dreamermx

  • 4 weeks later...
DREAMERMX Principiante

DREAMERMX

publicado
  • Autor
publicado
Hace 6 minutos , Janlui dijo:

Este tema ya se te resolvió en TodoExcel. 

Estimado, aquí trato de resolver otra alternativa muy diferente que es generar un autonumerico con la máscara  "REG-0001", veo difícil que sea la misma solución y tras frustrados intentos no logre resolverlo y la idea es aprender un poco de ambas alternativas. Yo no soy programador y tampoco me dedico a esto, pero soy entusiasta y me gusta generar cosas nuevas y útiles y ese tipo de problema siempre es con el que me he topado. generar una numeracion automatica de forma simple. Gracias por tu interés. Saludos!

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • DiegoPC
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por DiegoPC · publicado

      Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.