Saltar al contenido

Registro lento de una un formulario a una Hoja de excel.


Recommended Posts

publicado

buen dia

el problema que tengo es el siguiente:

ocupó este código para registrar  información en una base de datos de excel, el problema que tengo es que  a la hora de hacer funcionar  el código por medio de un botón, tarda mucho en registrar porque la base de datos ya tiene 5,345 registros. quiero suponer que el problema está a la hora que busca la ultima fila vacía, hasta que la encuentra registra.

Dim ifila As Long
Dim ws As Worksheet
Set ws = Sheets("BDPAGOS")
ifila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(ifila, 1).Value = Me.NOFACTURA.Value
ws.Cells(ifila, 2).Value = VBA.CDate(Me.FECHAPAGO.Value)
ws.Cells(ifila, 3).Value = Me.BANCO.Value
ws.Cells(ifila, 4).Value = Me.CHEQUE.Value
ws.Cells(ifila, 5).Value = VBA.CDbl(Me.IMPORTEP.Value)
ws.Cells(ifila, 6).Value = Me.ESTATUS.Value

 

espero haber sido claro exponiendo mi problema y agradezco infinitamente a las personas que nos ayudan a resolverlos.

Gracias anticipadas.

 

publicado
Hace 53 minutos , JSDJSD dijo:

Hola happy-christian, sube tu archivo aunque sea con datos ficticios

Hola JSDJSD  gracias por responder

arme un archivo nuevo con el código, pero ahí no me dio el problema, estoy subiendo todo el codigo que utilizo en el formulario.  el problema lo tengo en el código de guardar Lo identifique.

espero puedan ayudarme a que se pueda guardar mas rápido.

Private Sub NOFACTURA_Change()
Worksheets("DATOS").Range("A3") = NOFACTURA.Value


FECHAFAC.Value = Worksheets("DATOS").Range("B3")
FECHASOLI.Value = Worksheets("DATOS").Range("C3")
FECHAVEN.Value = Worksheets("DATOS").Range("H3")
AVISO.Value = Worksheets("DATOS").Range("I3")
CONDICION.Value = Worksheets("DATOS").Range("G3")
IMPORTE.Value = Worksheets("DATOS").Range("F3").Text
PROVEEDOR.Value = Worksheets("DATOS").Range("D3")
MATERIAL.Value = Worksheets("DATOS").Range("E3")
MONEDA.Value = Worksheets("DATOS").Range("J3")
FECHAENVIO.Value = Worksheets("DATOS").Range("C6")

ESTATUSAC.Value = Worksheets("DATOS").Range("H6")


End Sub

'EL PROBLEMA TIENE QUE ESTAR POR AQUI DONDE SE GUARDA LA INFORMACION--------------------------------------------------------------'



Private Sub GUARDAR_Click()
Application.ScreenUpdating = False


Sheets("CONTROL").Select
If Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(NOFACTURA, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
  MsgBox "El numero de la factura ingresada no esta en la base de datos de control de pagos verifique", 64, ""
Exit Sub
End If

Sheets("BDPAGOS").Select
If Not Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(NOFACTURA, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
  MsgBox "El numero de la factura ingresada ya existe en esta lista, por favor verifique", 64, ""
Exit Sub
End If

Dim ifila As Long
Dim ws As Worksheet
Set ws = Sheets("BDPAGOS")
ifila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

If Trim(Me.NOFACTURA.Value) = "" Then
Me.NOFACTURA.SetFocus
MsgBox "INGRESE EL NUMERO DE LA FACTURA"
Exit Sub
End If


If Trim(Me.FECHAPAGO.Value) = "" Then
Me.FECHAPAGO.SetFocus
MsgBox "INGRESA LA FECHA DE PAGO"
Exit Sub
End If

If Trim(Me.BANCO.Value) = "" Then
Me.BANCO.SetFocus
MsgBox "INGRESE EL BANCO DONDE SE PAGO LA FACTURA"
Exit Sub
End If


If Trim(Me.CHEQUE.Value) = "" Then
Me.CHEQUE.SetFocus
MsgBox "INGRESE LOS DIAS DE CONDICION DE PAGO"
Exit Sub
End If

If Trim(Me.IMPORTEP.Value) = "" Then
Me.IMPORTEP.SetFocus
MsgBox "SELECCIONE UN PROVEEDOR DE LA LISTA SI ESTE NO SE ENCUENTRA REGISTRELO CON EL BOTON REGISTRAR PROVEEDOR"
Exit Sub
End If

If Trim(Me.ESTATUS.Value) = "" Then
Me.ESTATUS.SetFocus
MsgBox "SELECCIONE EL ESTATUS DE LA FACTURA"
Exit Sub
End If


RPTA = MsgBox("¿DESEA REGISTRAR LA INFORMACION ?", vbYesNo + vbQuestion)
    If RPTA = vbNo Then Exit Sub
    

ws.Cells(ifila, 1).Value = Me.NOFACTURA.Value
ws.Cells(ifila, 2).Value = VBA.CDate(Me.FECHAPAGO.Value)
ws.Cells(ifila, 3).Value = Me.BANCO.Value
ws.Cells(ifila, 4).Value = Me.CHEQUE.Value
ws.Cells(ifila, 5).Value = VBA.CDbl(Me.IMPORTEP.Value)
ws.Cells(ifila, 6).Value = Me.ESTATUS.Value


Sheets("BDPAGOS").Select


Range("G4").Select
Selection.Copy
Range("G" & Cells.Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("G4").Select

Sheets("MENU").Select


NOFACTURA.Value = ""
FECHAPAGO.Value = ""
FECHASOLI.Value = ""
BANCO.Value = ""
CHEQUE.Value = ""
IMPORTEP.Value = ""
ESTATUS.Value = ""

NOFACTURA.SetFocus

End Sub



'EL PROBLEMA TIENE QUE ESTAR HASTA AQUI ------------------------------------------------------------------------------------------'

Private Sub Salir_Click()
Application.ScreenUpdating = False
   
NOFACTURA.Value = ""
FECHAPAGO.Value = ""
FECHASOLI.Value = ""
BANCO.Value = ""
CHEQUE.Value = ""
IMPORTEP.Value = ""
ESTATUS.Value = ""
    
    Unload Me
    
    Sheets("CONTROL").Select
    Range("A3:Q3").Select
    Selection.AutoFilter
    
    
    Sheets("MENU").Select
    
Worksheets("CONTROL").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="CONTROL01"
    Worksheets("BDFECHAENTRADA").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="CONTROL01"
     Worksheets("BDPAGOS").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="CONTROL01"
    Worksheets("DATOS").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="CONTROL01"
    Worksheets("FORMATO").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="CONTROL01"

End Sub

Private Sub UserForm_Initialize()

Application.ScreenUpdating = False

Worksheets("CONTROL").Unprotect Password:="CONTROL01"
    Worksheets("BDFECHAENTRADA").Unprotect Password:="CONTROL01"
    Worksheets("BDPAGOS").Unprotect Password:="CONTROL01"
    Worksheets("DATOS").Unprotect Password:="CONTROL01"
Worksheets("FORMATO").Unprotect Password:="CONTROL01"

Sheets("CONTROL").Select
Range("A3").Select

Do While ActiveCell <> Empty

    ActiveCell.Offset(1, 0).Select

    NOFACTURA.AddItem ActiveCell
Loop

Sheets("CONTROL").Select
    Range("A3:Q3").Select
    Selection.AutoFilter

Sheets("MENU").Select
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, ModoCerrar As Integer)
       If ModoCerrar <> 1 Then Cancel = 1
End Sub

Private Sub vercalendario_Click()


End Sub

Private Sub VCalendario_Click()
'Control de visualización del calendario
FechaActiva = ""
Set ControlActivo = FECHAPAGO
If IsDate(FECHAPAGO) = True Then FechaActiva = FECHAPAGO



Calendario.Show
End Sub



Private Sub UserForm_Terminate()

Unload Calendario

End Sub

 

saludos!

 

publicado
Hace 1 hora, JSDJSD dijo:

Sube el archivo que te da problemas

Hola JSDJSD

por el tamaño no me permite subir mi archivo pero puedes descargarlo de este link por favor.

https://1drv.ms/x/s!AhTpeRiQWgCGhitfIcOaSq93oWvy

este programa fue diseñado para controlar los pagos de los proveedores, y el problema lo estoy teniendo a la hora de registrar un pago.

Region%20Capture%201_zps9yavq81b.jpg

para registrar un pago tomamos una de las ultimas facturas porque las primeras ya tienen un pago registrado y te avisara del mismo y no te permitira registrar.

 

Region%20Capture%202_zpsrvyljc6y.jpg

 

ya que se llenen los textbox que estan en blanco le damos en registrar, ahí es donde tengo el problema porque tarda mucho en registrarme un pago

 

Region%20Capture%203_zpsj99daquh.jpg

 

toda la información se guarda en la siguiente hoja:

Region%20Capture%204_zpst6ra5cgy.jpg

Region%20Capture%205_zps1jpdj64n.jpg

 

espero y no tengas problemas para descargar mi archivo, te agradezco mucho tu ayuda

saludos!!

publicado
Hace 9 horas, JSDJSD dijo:

hola JSDJSD

revise tu archivo y veo que se cambio el formato de la tabla de la base de datos de los pagos, el problema al parecer se soluciono pero lo que veo que al hacer el cambio de esa tabla varias formulas que se concentraban en la Hoja de control se desajustaron y daban error, cambie las formulas y realice unas pruebas de registro de pago y me volvió a dar el problema de tardarse tanto en el registro.

estoy anexando tu archivo con la corrección de las formulas para que puedas ver lo que te comento.

https://1drv.ms/u/s!AhTpeRiQWgCGhjKlTuZgWevFESow

te agradezco mucho tu ayuda 

 

saludos!!

publicado
Hace 3 minutos , happy-christian dijo:

Te funciono bien el archivo que te mandé ?

O Como podría modificar mi macro para que a la hora de que busque la última celda vacía busque desde las ultimas Celdas llenas y no tenga que estar buscando desde la filial uno. 

 

Es es decir en vez de empezar por la filial uno que empiece a buscar desde fila 5340 y de ahí hacia abajo para buscar la fila vacía. Como podría modificar esta indicación en mi macro?

Dim ifila As Long
Dim ws As Worksheet
Set ws = Sheets("BDPAGOS")
ifila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ws.Cells(ifila, 1).Value = Me.NOFACTURA.Value
ws.Cells(ifila, 2).Value = VBA.CDate(Me.FECHAPAGO.Value)
ws.Cells(ifila, 3).Value = Me.BANCO.Value
ws.Cells(ifila, 4).Value = Me.CHEQUE.Value
ws.Cells(ifila, 5).Value = VBA.CDbl(Me.IMPORTEP.Value)
ws.Cells(ifila, 6).Value = Me.ESTATUS.Value
publicado
ifila = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

 

 

Tu código busca desde el final de la hoja hacia arriba, hata encontrar la la primera fila con datos y con Offset(1,0), al encontrar la última fila en uso, salta 1 fila más la cual sería la última fila libre, cosa que está bién.

Con respecto a si me funciona el archivo que has subido sí.

 

 

publicado
Hace 2 horas, JSDJSD dijo:

Mira en el enlace como funciona perfectamente tu formulario con el último archivo que has subido.

 

https://www.dropbox.com/s/smkomwhd3yu3re6/2019-03-29_21-29-49.gif?dl=0

Una disculpa soy un **maravilloso** subi el mismo archivo que me enviaste, y tenia que subvierte el archivo donde solo corregi las formulas que se movieron por el cambio de la  tabla que hiciste.

este es el archivo correcto.

https://mega.nz/#!s8dwCADT!QJmYqabesTGctAwn7Mfi3WDW_-7Pscr5Q7vRoVdbKhs

https://1drv.ms/u/s!AhTpeRiQWgCGhjTfOiDbNX0eZHJL

espero no desesperarte, te agradezco mucho tu ayuda.

saludos!!

 

publicado
Hace 9 horas, JSDJSD dijo:

Que formulas son las que se desajusta ?

en la hoja de control 

HOJAS_zpsvy2muxlz.jpg

 

de la columna L HASTA P se tiene formulado para traer los datos que registramos del pago, esas son las formulas que se desajustaron cuando se cambio la tabla de pagos, al corregirlas nos vuelve a dar el error.

FORMULAS_zpsctsn2wv5.jpg

 

saludos y muchas gracias por tu ayuda.

 

CHRISTIAN ZAMORA.

 

Archivado

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

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

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


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      28

    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Por pegones1

    1    1

  • Crear macros Excel

  • Mensajes

    • Vale mil gracias, en vdd se agradece todo el apoyo y comentarios
    • Hola nuevamente. Por eso la importancia de lo que mencionas tú como "ruta relativa". Tal cual comentas, y aún sin llegar a algunos detalles importantes para ayudarte, en realidad tal cual te comenté le día miércoles, pues sí podías hacer como comentabas, era cosa de obtener los Id de Windows (como tú los llamas) y la ruta de OneDrive en casa usuario y eso sí se puede obtener con VBA y luego pasarlo a PQ, pero medio que te cerraste en que "PQ no puede trabajar con rutas relativas", cosa cierta pero siempre hay formas. Si SAP puede o no guardar en OneDrive o SharePoint, pues si está mapeado en la PC ¡claro que se puede! Pero bueno, creo que si te es útil tu propia propuesta ¡avanza con eso!
    • Perdona @Abraham Valencia pero he estado liado estos días. En realidad todo el problema se reduce a estos dos problemas: Problema 1: El script que "fabrica" SAP y que luego "pego" en la macro, no es capaz de  guardar archivos en SharePoint. He estado buscando, y en realidad muchas personas tienen ese problema (no poder guardar un Excel en SAP a través de VBA). Eso muy probablemente sean problemas de permisos, que no puedo cambiar (no soy administrador de nada). Como no puedo solucionarlo así, paso al plan B, que es guardar en Excel que me genera SAP en el ordenador de cada usuario que ejecute la plantilla (y que sí está guardada en SharePoint), para después con PowerQuery llamar a ese Excel (el export). Para ello, pretendo guardar el export, en la ruta relativa "C:\..\..\..\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" donde los \..\..\..\ saltan las rutas personales de cada usuario (tipo C:\users\IDusuario\). Eso lo hace bien, y el archivo se guarda en la ruta de cada usuario que lo usa, pero surge el problema 2 Problema 2: PowerQuery no trabaja con rutas relativas del tipo  "C:\..\..\..\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" necesita que sea del tipo fija "C:\users\IDusuario\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" pero claro, IDusuario es diferente para cada usuario.   Pero escribiendo todo esto, creo que he dado con una posible solución, no grabar el export en una ruta de usuario, sino en una en la raiz de C:, que siempre será igual para todos los usuarios, del tipo C:\Sap\export.xlsx que seria igual en todos los ordenadores. Asi sí podría decirle a PowerQuery que vaya siempre a la ruta C:\Sap\ que existirá en todos los ordenadores. Mañana intentaré hacer pruebas, aunque mi solución ideal seria que se pudiera guardar en el SharePoint. Saludos.
    • Hola La opción brindada por @torquemada es correcta, funciona, pero hay algunos inconvenientes que (desde mi punto de vista) no la convierten en mi primera elección. Los inconvenientes son: Tendrías que ir columna por columna haciendo los reemplazos, claro que no se harían a mano sino que utilizarías la opción reemplazar o la opción texto en columnas, aun asi demorará un poquito y será trabajoso. Cada vez que descargues otro listado, tendrás que volver a realizar los reemplazos. Me parece una mejor propuesta lo siguiente: Descarga los movimientos a un archivo de Excel Desde tu control de pagos (otro archivo) cargas los movimientos del archivo descargado mediante Power Query Power Query hará los reemplazos y reconocerá todo correctamente (sin que tengas que hacer nada especial) Cuando descargues los movimientos un día posterior, solamente tendrás que hacer clic en "Actualizar" y todo funcionará en automático
    • Hola a todos, Efectivamente, me temo que tal como trabajan las funciones =HOY() y/o =AHORA() (volátiles), sólo con macros puedes obtener soluciones. Un recurso pedestre podría ser, cada vez que quieras que se fije un dato, te sitúes en esa celda y pulses F2, F9 e INTRO.  Pero claro, puede ser un inconveniente si hay que hacerlo repetitivamente en muchas ocasiones,.............. en fin, lo comento sólo como posibilidad. Saludos,
  • 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.