Modificar Macro para ingreso con datos repetidos
Tengo dos inconvenientes, el primero es que necesito ajustar la siguiente Macro, para poder ingresar datos repetidos, debido a que esta Macro, solo permite el ingreso de registros únicos.
El motivo es que necesito registrar Ordenes de compra, y necesito ingresar cada producto de forma individual, por lo que necesitare ingresar el codigo de la Orden de compra, por cada producto.
Lo segundo es que esta Macro debería traspasar cada nuevo ingreso a una fila diferente, sin embargo siempre sobrescribe la información en la misma fila.
Function insertarRegistro(OrdendeCompra As String, Fecha As String, N°deTransporte As String, Proveedor As String, GuiadeDespacho As String, Factura As String, Cantidad As String, Producto As String, Comentario As String, CentrodeCosto As String) As String
Dim ultFila, filaRegistro, existe As Long
Dim confirmacionRegistro As String
confirmacionRegistro = "NO"
ultFila = Range("B" & Rows.Count).End(xlUp).Row
If ultFila < 8 Then
filaRegistro = 8
Else
filaRegistro = ultFila + 1
End If
If ultFila < 8 Then
ultFila = 8
End If
existe = filaExisteRegistro(OrdendeCompra, "B8:B" & ultFila)
If existe > 0 Then
MsgBox "Ya existe un registro asociado a esta Orden de Compra"
insertarRegistro = confirmacionRegistro
Exit Function
End If
Entradas.Cells(filaRegistro, 2) = OrdendeCompra
Entradas.Cells(filaRegistro, 3) = Fecha
Entradas.Cells(filaRegistro, 4) = N°deTransporte
Entradas.Cells(filaRegistro, 5) = Proveedor
Entradas.Cells(filaRegistro, 6) = GuiadeDespacho
Entradas.Cells(filaRegistro, 7) = Factura
Entradas.Cells(filaRegistro, 8) = Cantidad
Entradas.Cells(filaRegistro, 9) = Producto
Entradas.Cells(filaRegistro, 10) = Comentario
Entradas.Cells(filaRegistro, 11) = CentrodeCosto
MsgBox "Ingreso registrado exitosamente"
confirmacionRegistro = "Ingresado"
insertarRegistro = confirmacionRegistro
End Function
Private Function filaExisteRegistro(noIdentificacion As String, rangoConsulta As String) As Long
Dim numeroFila As Long
numeroFila = 0
With Entradas.Range(rangoConsulta)
Set c = .Find(noIdentificacion, LookIn:=xlValues)
If Not c Is Nothing Then
numeroFila = c.Row
End If
End With
filaExisteRegistro = numeroFila
End Function
Sub verFormularioIngresoDatos()
Formingreso.Show
End SubY este es el codigo del Userform
Private Sub cmdguardar_Click() Dim confirmacionRegistro As String If Len(txtOrdendeCompra) = 0 Or Len(txtFecha) = 0 Or Len(txtN°deTransporte) = 0 Or Len(txtProveedor) = 0 Or Len(TxtGuiadeDespacho) = 0 Or Len(txtFactura) = 0 Or Len(txtCantidad) = 0 Or Len(txtProducto) = 0 Or Len(txtComentarios) = 0 Or Len(lstCentrodeCosto) = 0 Then MsgBox " Favor completar todos los campos" Exit Sub End If confirmacionRegistro = Módulo1. InsertarRegistro(txtOrdendeCompra, txtFecha, txtN°deTransporte, txtProveedor, TxtGuiadeDespacho, txtFactura, txtCantidad, txtProducto, txtComentarios, lstCentrodeCosto) If confirmacionRegistro <> "NO" Then txtOrdendeCompra = "" txtFecha = "" txtN°deTransporte = "" txtProveedor = "" TxtGuiadeDespacho = "" txtFactura = "" txtCantidad = "" txtProducto = "" txtComentarios = "" lstCentrodeCosto = "" End If End Sub
[Hola
prueba esto
Function insertarRegistro(OrdendeCompra As String, Fecha As String, N°deTransporte As String, Proveedor As String, GuiadeDespacho As String, Factura As String, Cantidad As String, Producto As String, Comentario As String, CentrodeCosto As String) As String
Dim ultFila, existe As Long
Dim confirmacionRegistro As String
confirmacionRegistro = "NO"
ultFila = Range("B" & Rows.Count).End(xlUp).Row + 1
If ultFila < 8 Then ultFila = 8
Entradas.Cells(ultFila, 2) = OrdendeCompra
Entradas.Cells(ultFila, 3) = Fecha
Entradas.Cells(ultFila, 4) = N°deTransporte
Entradas.Cells(ultFila, 5) = Proveedor
Entradas.Cells(ultFila, 6) = GuiadeDespacho
Entradas.Cells(ultFila, 7) = Factura
Entradas.Cells(ultFila, 8) = Cantidad
Entradas.Cells(ultFila, 9) = Producto
Entradas.Cells(ultFila, 10) = Comentario
Entradas.Cells(ultFila, 11) = CentrodeCosto
MsgBox "Ingreso registrado exitosamente"
confirmacionRegistro = "Ingresado"
insertarRegistro = confirmacionRegistro
End Function
Sub verFormularioIngresoDatos()
Formingreso.Show
End SubPrivate Sub cmdguardar_Click() Dim confirmacionRegistro As String If Len(txtOrdendeCompra) = 0 Or Len(txtFecha) = 0 Or Len(txtN°deTransporte) = 0 Or Len(txtProveedor) = 0 Or Len(TxtGuiadeDespacho) = 0 Or Len(txtFactura) = 0 Or Len(txtCantidad) = 0 Or Len(txtProducto) = 0 Or Len(txtComentarios) = 0 Or Len(lstCentrodeCosto) = 0 Then MsgBox " Favor completar todos los campos" Exit Sub End If confirmacionRegistro = Módulo1. InsertarRegistro(txtOrdendeCompra, txtFecha, txtN°deTransporte, txtProveedor, TxtGuiadeDespacho, txtFactura, txtCantidad, txtProducto, txtComentarios, lstCentrodeCosto) If confirmacionRegistro <> "NO" Then txtOrdendeCompra = "" txtFecha = "" txtN°deTransporte = "" txtProveedor = "" TxtGuiadeDespacho = "" txtFactura = "" txtCantidad = "" txtProducto = "" txtComentarios = "" lstCentrodeCosto = "" End If End Sub
El problema es que me sigue sobre-escribiendo los datos nuevos en la fila 8, por lo que no puedo comprobar si se pueden incluir registros duplicados.
Además se produce un error en el ListBox( centro de costos), al darle a grabar con el commandbuton ( Aceptar), cuando no se elige un dato de ese listbox.
Saludos Cordiales.
Pido disculpas, lo he probado de nuevo, y esta funcionando correctamente, permite registros repetidos y estos van ingresándose hacia abajo en las filas. Solo mantengo el problema con el Listbox,, que al no seleccionarse un dato del mismo, y al darle en guardar, me manda a depuración.
Muchas gracias y espero puedas ayudarme con esto ultimo.
En la función no está para listbox o mejor envíame tu archivo [email protected] para adecuar la macro
Mi email es: [email protected]
Te envíe correo, muchas gracias!
Te envié tu archivo con los cambios.
Para cada petición crea una nueva pregunta saludos!
