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

Consecutivo deacuerto a formato

viejo

Por viejo
en Macros y programación VBA

Recommended Posts

viejo Principiante

viejo

publicado
publicado

Buen Dia tengan grandes expertos de la programacion,  acudo a ustedes para ver si me pueden auxiliar respecto a un tema que aparentemente esta muy sencillo pero por mas que le doy vueltas no logro que me salga, espero su valiosa colaboracion para poder terminar esa parte que me hace falta, les explico brevemente pues se trata del registro de 3 campos en una hoja mediante formulario el cual en su parte de inicialize hace o realiza un numero consecutivo, mi problema radica aqui en hacer que ese consecutivo se haga deacuerdo a un formato el cual es el siguiente:

34-07-00-000020-A

en el formato lo que quiero que vaya cambiando es lo que esta con negritas, (osea 34-07-00-000021-A, 34-07-00-000022-A, 34-07-00-000023-A etc;) y lo demas se quede tal cual, ¿como pudiera hacer eso deacuerdo al formulario que tengo?, alguien que me ayude, porfavor.

dejo archivo muestra. de antemano muchas gracias

GenerarConsecutivo.rar

Antoni Veterano

Antoni

publicado
publicado

Sin ve la respuesta de Haplox: 

Public Sub INCREMENTARID()
Dim FIN As Range
With Sheets("Hoja1")
   If .Range("A2") = Empty Then
      frmAlta.txtID = 1
   Else
      Set FIN = .Range("A1").End(xlDown)         
      frmAlta.txtID = Left(FIN, 9) & _
                      Format(CLng(Mid(FIN, 10, 6)) + 1, "000000") & _
                      Mid(FIN, 16)
   End If
End With
End Sub

 

viejo Principiante

viejo

publicado
  • Autor
publicado

Buen día tengan Haplox y maestro Antoni, de antemano gracias por la aportación, sin embargo al probar el codigo me marca errores para ambos, que les mostraré:

- para el caso de Haplox:

el codigo cumple con la funcion de incrementar el ultimo digito en el formulario, pero cuando inserto en celda solo inserta el 34, no se que sucede ahi

- para el caso de Antoni:

el codigo no me funciona

- para ambos casos:

veo que solo modifica el ultimo digito, pero ¿que pasará cuando llegue al siguiente digito?, es decir, ¿ese "registro de corrimiento" no se dará?, osea asi:

34-07-00-000001-A

34-07-00-000002-A

34-07-00-000003-A

34-07-00-000004-A

34-07-00-000005-A

... 34-07-00-000010-A

 

antoni.rar

Antoni Veterano

Antoni

publicado
publicado

La parte numérica debe estar en las posiciones 10-15 del código, de lo contrario dará el error que comentas.

Sube el archivo en el que se te produce el error para poderlo reproducir.

Leopoldo Blancas Novato

Leopoldo Blancas

publicado
publicado

Prueba... 

Private Sub UserForm_Initialize()
Dim uf&, aDatos
    uf = Hoja1.Range("A" & Rows.Count).End(xlUp).Row
    aDatos = Split(Hoja1.Cells(uf, "A"), "-")
    aDatos(3) = CDbl(aDatos(3)) + 1
    txtID = aDatos(0) & "-" & aDatos(1) & "-" & aDatos(2) & "-" & Format(aDatos(3), "000000") & "-" & aDatos(4)
End Sub

Saludos

Leopoldo Blancas Novato

Leopoldo Blancas

publicado
publicado

Private Sub UserForm_Initialize()
Dim uf&, aDatos
    uf = Hoja1.Range("A" & Rows.Count).End(xlUp).Row
    aDatos = Split(Hoja1.Cells(uf, "A"), "-")
    aDatos(3) = Format(CDbl(aDatos(3)) + 1, "000000")
    txtID = Join(aDatos, "-")
End Sub

Antoni Veterano

Antoni

publicado
publicado

En el archivo que has subido no está sustituido el procedimiento INCREMENTARID del Módulo1, por el que yo subí, sustitúyelo y verás como funciona.

viejo Principiante

viejo

publicado
  • Autor
publicado

Leopoldo cual de los dos codigos debo probar?, en ambos casosme marca error 9 en tiempo de ejecucion subindice fuera de intervalo

en esta linea

    aDatos(3) = CDbl(aDatos(3)) + 1

 

Antoni Veterano

Antoni

publicado
publicado

Si no sabes para que sirven las funciones, no las uses:

.Cells(NewRow, 1).Value = Val(Me.txtID) está mal, debe ser .Cells(NewRow, 1).Value = Me.txtID

 

Leopoldo Blancas Novato

Leopoldo Blancas

publicado
publicado
Hace 22 minutos , viejo dijo:

Leopoldo cual de los dos codigos debo probar?, en ambos casosme marca error 9 en tiempo de ejecucion subindice fuera de intervalo

en esta linea

    aDatos(3) = CDbl(aDatos(3)) + 1

 

:blink:

Te subo archivo... AL ABRIR EL FORMULARIO DE ALTAS AUTOMATICAMNETE TE DA EL CONSECUTIVO.

Saludos.

GenerarConsecutivo.xlsm

viejo Principiante

viejo

publicado
  • Autor
publicado

hay algo que no entiendo...¿porque en un principio el formulario de frmAlta si funcionó y despues de cerrarlo ya no lo hizo? y me marcó error 9 en tiempo de ejecucion: subindice fuera de intervalo ¿pues que no se supone que funcionaba y al funcionar se descompuso? o que:D?

el detalle es que no funciona y ahora ya no se porque

Leopoldo Blancas Novato

Leopoldo Blancas

publicado
publicado

hay veces que los archivos se dañan... por diversas formas, virus, se cerro mal, etc... lo más sano cuando ya no hace lo que hacia es copiar todo a un nuevo archivo...o Hay veces que hay código que entorpece a otro... y no lo deja trabajar normalmente...o Guardamos en la celda algo que Excel -LA MACRO- ya no lo reconoce y por eso te manda ese error....

Hace 40 minutos , viejo dijo:

error 9 en tiempo de ejecucion subindice fuera de intervalo

Saludos.

 

viejo Principiante

viejo

publicado
  • Autor
publicado
Hace 24 minutos , Leopoldo Blancas dijo:

En tu celda de la columna A debe de tener este formato 34-07-00-000003-A

ah caray y eso como es?...con click derecho y en formato de celda o como?

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.