Autor
|
Tema: AYUDA!! MEJORAR EL CODIGO PARA QUE EL PROCESO LO HAGA MAS RAPIDO (Leído 2,964 veces)
|
agmen
Desconectado
Mensajes: 17
|
Hola nuevamente, espero que se encuentren todos bien... tengo el siguiente problema, he tratado de optimizar el codigo para que el proceso lo haga mas rapido no he logrado mejores resultados que el codigo que mas adelante expondré. el ejercicio es el siguiente: tengo un archivo base (ARCHIVO_BASE.TXT) con 363.674 registros (el archivo base que pondre aka tiene una cantidad mucho menor) 20100817036367300000005124506158 001058913920091015200911102010082600000500410000031891920053866123 00099778632009072120090815201008260000286741000003189193005386628K 001058915120091015200911102010082600002770410000031892080053867960 000997793920090721200908152010082600001716410000031892450053872220 001202927320100411201005052010082600014820410000031892470053872549 001307911820100811201009052010082600008610410000031892510053872786 000012517820100807201009012010082600006030390000031892540053872816 000997785420090721200908152010082600001417410000031892570053873081 001201805520100411201005052010082600005320410000001963750132585601 001226921820100507201006012010082600000182410000001966660132612358 001058913920091015200911102010082600000500410000031891920053866123 00099778632009072120090815201008260000286741000003189193005386628K 001058915120091015200911102010082600002770410000031892080053867960 000997793920090721200908152010082600001716410000031892450053872220 001202927320100411201005052010082600014820410000031892470053872549 001307911820100811201009052010082600008610410000031892510053872786 000012517820100807201009012010082600006030390000031892540053872816 000997785420090721200908152010082600001417410000031892570053873081 001201805520100411201005052010082600005320410000001963750132585601 001226921820100507201006012010082600000182410000001966660132612358
este archivo debe ser recorrido y guardar en otra archivo llamado "RUTS.TXT " los RUT de estos registros se encuentran en la posición 58 y tiene un largo de 9 caracteres. estos RUT se encuntran algunas veces duplicados x cantidad de veces por lo cual hay que dejar solo 1 de de cada RUT repetido. el archivo "RUTS.TXT" quedaria asi: 053866123 05386628K 053867960 053872220 053872549 053872786 053872816 053873081 132585601 132612358
con este archivo tendremos que recorrer nuevamente el archivo "ARCHIVO_BASE.TXT" e ir haciendo una sumatorio de uno de los campos en este caso el campo monto, para si dejar solo 1 rut de los x que se repiten con la sumatoria de los montos y los demas datos que para el ejercicio no tiene importancia. dejo a continuación el archivo "ARCHIVO_FINAL.txt" con el filtro de RUT ya hecho y con la sumatoria de los montos cuando se repite el RUT. 001058913920091015200911102010082600001000410000031891920053866123 00099778632009072120090815201008260000573441000003189193005386628K 001058915120091015200911102010082600005540410000031892080053867960 000997793920090721200908152010082600003432410000031892450053872220 001202927320100411201005052010082600029640410000031892470053872549 001307911820100811201009052010082600017220410000031892510053872786 000012517820100807201009012010082600012060390000031892540053872816 000997785420090721200908152010082600002834410000031892570053873081 001201805520100411201005052010082600010640410000001963750132585601 001226921820100507201006012010082600000364410000001966660132612358
resalto el campo con la sumatoria 0010589139200910152009111020100826 00001000 410000031891920053866123 0009977863200907212009081520100826 00005734 41000003189193005386628K 0010589151200910152009111020100826 00005540 410000031892080053867960 0009977939200907212009081520100826 00003432 410000031892450053872220 0012029273201004112010050520100826 00029640 410000031892470053872549 0013079118201008112010090520100826 00017220 410000031892510053872786 0000125178201008072010090120100826 00012060 390000031892540053872816 0009977854200907212009081520100826 00002834 410000031892570053873081 0012018055201004112010050520100826 00010640 410000001963750132585601 0012269218201005072010060120100826 00000364 410000001966660132612358
el campo a sumar se encuentra en el archivo "ARCHIVO_BASE.TXT" y esta en la pocición 35 con un largo de 8 caracteres a continuación el codigo fuente: se necesita un boton , un modulo y un commonDialog llamado "cd" codigo para el boton: Private Sub Command1_Click()
Private Sub Command1_Click()
Dim ARCHIVO_RUT As String Dim DIRECCION As String Dim RUT1 As String Dim SW2 As Integer Dim rutrut As String Dim campo1 As String Dim campo3 As String Dim sumatoria As String Dim sumatoriaVal As Long
EscriveLog "", "RUTS" ' crea el archivo "RUTS" y guarda un espacio en blanco ARCHIVO_RUT = App.Path & "\" & "RUTS.txt" ' se guarda la direccion del archivo "RUTS" cd.ShowOpen ' abre una ventana para buscar el archivo base DIRECCION = cd.FileName ' la direccion se guarda en una variable Open DIRECCION For Input As #1 ' abrimos el archivo While Not EOF(1) ' lo recorremos mientras no sea fin de archivo Line Input #1, linea1 ' se posiciona en la primera o la siguiente linea del archivo RUT1 = Mid$(linea1, 58, 9) ' en la posicion 58 de largo 9 se encuentra el rut y lo guardamos If RUT1 <> "" Then ' si el rut es distindo de vacio haga Open ARCHIVO_RUT For Input As #2 ' abrir el archivo donde se guardan los rut While SW2 = 0 And Not EOF(2) ' hacemos mienrras el sw2 sea igual a 0 Line Input #2, linea2 ' se posiciona en la primera o siguiente linea rutrut = Mid$(linea2, 1, 9) ' se guarda lo que se encuntre en la posicion 1 de lsrgo 9 If RUT1 = rutrut Then ' si el rut del archivo base = a los que se tomo del archivo_rut SW2 = 1 ' el sw2 toma el valor 1 End If Wend Close #2 If SW2 = 0 And RUT1 <> "" Then si el sw2 es cero es pq el rut no esta repetido en el archivo RUTS EscriveLog RUT1, "RUTS" ' se guarda el rut nuevo en el archivo RUTS End If SW2 = 0 ' se deja nuevamente el valor del sw2 en cero End If Wend ' se va al siguiente registro si no es fin de archivo Close #1 ' cerramos el archivo sumatoria = 0
Open ARCHIVO_RUT For Input As #1 ' abrimos el archivo que contiene los rut una sala vez While Not EOF(1) ' hacemos mientras no sea find e archivo Line Input #1, linea1 ' nos posicionamos en la primera o la siguiente linea RUT1 = Mid$(linea1, 1, 9) ' se almacena el valor de el rut If RUT1 <> "" Then ' si el rut es distinto de blanco Open DIRECCION For Input As #2 ' abrimos el archivo base While Not EOF(2) ' hacemos mientras no sea finde archivo Line Input #2, linea2 ' no sposicionamos en el primero o siguiente registro rut2 = Mid$(linea2, 58, 9) ' guardamos el rut del registro del archivo base If RUT1 = rut2 Then ' comparamos el rut del archivo base con el el contenedor de rut campo1 = Mid$(linea2, 1, 34) 'dato que no importa campo3 = Mid$(linea2, 43, 24) ' dato que no importa sumatoria = Mid$(linea2, 35, 8) ' guardamos el monto (string) del archivo base sumatoriaVal = Val(sumatoria) ' pasamos de string a numerico sumatoria = sumatoria + sumatoriaVal ' sumamos lo que tiene sumatoria con el numerico sumatoria = Str(sumatoria) ' pasamos la sumatoria a string sumatoriaVal = Len(sumatoria) ' obtenemos el largo del string de sumatoria sumatoriaVal = sumatoriaVal - 1 ' al largo del string le restamos 1 sumatoria = Right$(sumatoria, sumatoriaVal) ' cortamos el string pq al pasarlo de numerico ' a string se crea un espacio en blanco sumatoriaVal = 8 - sumatoriaVal 'rellena con ceros a la izquierda While sumatoriaVal > 0 'para tener un string de largo 8 sumatoria = "0" + sumatoria ' sumatoriaVal = sumatoriaVal - 1 ' Wend End If
Wend sumatoria = campo1 + sumatoria + campo3 ' EscriveLog sumatoria, "ARCHIVO_FINAL" 'guardamos el registro en el archivo final sumatoria = 0 Close #2 End If Wend Close #1 MsgBox "FIN" End Sub
codigo para el modulo: Public Function EscriveLog(ByRef Texto As String, ByRef tipo As String) ', ByRef xTipo As Byte) Dim strFile As String Dim fn As Long Dim strLog As String strFile = App.Path & "\" & tipo & ".txt" fn = FreeFile strLog = Texto Open strFile For Append As fn Print #fn, strLog Close fn End Function
duración de lectura 104.000 registros en 90 minutos de un total de 363.674 espero me puedan ayudar, antes ya lo han hecho... de antemano MUCHISIMAS GRACIAS!!!
|
|
« Última modificación: 15 Octubre 2010, 17:21 pm por agmen »
|
En línea
|
|
|
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
HOLA!!! Me agrada tu proyecto. Me comi la cabeza y llegue a este resultado que reduce 10 o mas veces el tiempo de tu funcion. Private Sub Form_Load() Dim RUT(99999) As String Dim MONTO(99999) As Integer Dim INICIO(99999) As String Dim MEDIO(99999) As String Dim a As String Open App.Path & "\ARCHIVO_BASE.TXT" For Input As #1 Do Until EOF(1) Line Input #1, a Y = Y + 1 FLAG = True For X = 1 To Y If Mid$(a, 58, 9) = RUT(X) Then FLAG = False MONTO(X) = MONTO(X) + Mid$(a, 35, 8) End If Next If FLAG = True Then RUT(Y) = Mid$(a, 58, 9) MONTO(Y) = Mid$(a, 35, 8) INICIO(Y) = Mid$(a, 1, 34) MEDIO(Y) = Mid$(a, 43, 15) Else Y = Y - 1 End If Loop ' #############################BORRO ARCHIVO_FINAL.TXT#################### Open App.Path & "\ARCHIVO_FINAL.TXT" For Output As #2 Close #2 ' #############################BORRO ARCHIVO_FINAL.TXT#################### Open App.Path & "\ARCHIVO_FINAL.TXT" For Append As #2 Dim MONTOB As String 'PARA ESCRIBIR CON LOS CEROS For X = 1 To ubound(RUT) If RUT(X) = "" And MONTO(X) = 0 Then Exit For MONTOB = Right("00000000" & MONTO(X), 8) Print #2, INICIO(X) & MONTOB & MEDIO(X) & RUT(X) Next X Close #2 Close #1 End Sub
Supuse que archivo RUTS.txt no es necesario. Pero si lo queres, agrega este codigo entre el Close #2 y el Close #1 del final ' #############################BORRO RUTS.TXT#################### Open App.Path & "\RUTS.TXT" For Output As #2 Close #2 ' #############################BORRO RUTS.TXT#################### Open App.Path & "\RUTS.TXT" For Append As #2 For X = 1 To ubound(RUT) If RUT(X) = "" Then Exit For Print #2, RUT(X) Next X Close #2
Espero que te sirva mucho. Igual mi codigo se puede optimizar 80 mil veces mas. pero para eso estan los Cracks de este foro. Yo hago lo que puedo por ayudar. Pero estoy seguro que tiene que tardar mucho menos asi. P.D: Modifica el largo de los vectores a tu gusto pero ojo que hay un par de for que usan ese largo escrito, lo vas a tener que cambiar a mano. GRACIAS POR LEER!!!
|
|
« Última modificación: 15 Octubre 2010, 20:23 pm por 79137913 »
|
En línea
|
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!" "La peor de las ignorancias es no saber corregirlas"
79137913 *Shadow Scouts Team*
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
yo veo el problema en los Line Input #2, linea2
Mejor carga un Buffer de mmm 1 mega en memoria y recorres asi el archivo, es decir en memoria, en lugar de estar accediendo N Cantidad de Lineas al HD, recuerda que la memoria es mas rapida que la Lectura/Escrira en el HD. Dulces Lunas!¡.
|
|
« Última modificación: 15 Octubre 2010, 20:04 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
agmen
Desconectado
Mensajes: 17
|
79137913 acabo de llegar del almuerzo y he corrido el codigo, tuve unos problemas ya que en el archivo base, la primera linea no tenia el mismo largo de los demas registros pero con un if he solucionado eso.. te cuento .. son las 15:45 y he comenzado el proceso... espero tener los resultados esperados MUCHAS GRACIAS MAN... UN GRAN A PORTE EN EL FORO.. JUNTO CON TODOS LOS QUE DEDICAN SU VALIOSO TIEMPO EN AYUDAR A LOS DEMAS Saludos.. PD.: no ocupe el RUTS.txt.. y mas tarde te cuento el tiempo que ocupo en correr elproceso completo.
|
|
|
En línea
|
|
|
|
agmen
Desconectado
Mensajes: 17
|
ha ocurrido un problema, son las 16:35 y el proceso ha finalizado por un error Ver Imagen: http://s3.subirimagenes.com:81/privadas/previo/thump_1224097dibujo.jpgel proceso muere cuando X e Y toman un valor superior a los 100.000... :S Dim RUT(999999) As String Dim MONTO(999999) As Integer Dim INICIO(999999) As String Dim MEDIO(999999) As String Dim a As String Agregue un 9 mas a cada variable y espero que eso haya arreglado el problema, ahora estoy corriendo el proceso nuevamente Gracias
|
|
« Última modificación: 15 Octubre 2010, 22:18 pm por agmen »
|
En línea
|
|
|
|
DarkMatrix
Desconectado
Mensajes: 150
Nuestro Limite es la Imaginacion
|
Seria bueno que subieras el archivo base original para ver que tanto podemos optimizar el code. (comprimido) si es que no pesa mucho.
|
|
|
En línea
|
Todo aquello que no se puede hacer, es lo que no intentamos hacer. Projecto Ani-Dimension Digital Duel Masters (Juego de cartas masivo multijugador online hecho en Visual Basic 6.0) Desing by DarkMatrix
|
|
|
DarkMatrix
Desconectado
Mensajes: 150
Nuestro Limite es la Imaginacion
|
Bueno aqui mejore el codigo originalmente posteado, no se si sea mas rapido porque no lo probe con tantos registros, solo con los que el puso de ejemplo. Utiliza la memoria para realizar el proceso y no necesita del archivo RUTS.txt aunque lo deje por si acaso. Hize un solo bucle para todo el proceso lo cual es mas rapido ya que antes dijiste que campo1 y 2 no son necesarios. Suponiendo que el "rut" no se encuentra en los campos 1 o 2 hize este code: Option Explicit Private Sub Command1_Click() Dim DIRECCION As String Dim Sumatoria As String Dim Content() As String Dim I As Long Dim Regs As String Dim Llave As String Dim Ruts As String Dim V As Integer If Dir$(App.Path & "\RUTS.txt") <> "" Then Kill App.Path & "\RUTS.txt" If Dir$(App.Path & "\ARCHIVO_FINAL.txt") <> "" Then Kill App.Path & "\ARCHIVO_FINAL.txt" cd.ShowOpen ' abre una ventana para buscar el archivo base DIRECCION = cd.FileName ' la direccion se guarda en una variable Open DIRECCION For Input As #1 ' abrimos el archivo ' lo recorremos mientras no sea fin de archivo Content = Split(Input$(LOF(1), #1), vbCrLf) Close #1 For I = LBound(Content) To UBound(Content) If Content(I) <> "" Then Llave = Mid$(Content(I), 58, 9) Sumatoria = Mid$(Content(I), 35, 8) If Llave <> "" Then V = InStr(1, Regs, Llave) If V = 0 Then Regs = Regs & Llave & vbCrLf Ruts = Ruts & Content(I) & vbCrLf EscriveLog Llave, "RUTS" Else V = InStr(1, Ruts, Llave) Ruts = Replace$(Ruts, Mid$(Ruts, V - 23, 8), Format$(Val(Mid$(Ruts, V - 23, 8)) + Val(Sumatoria), "00000000")) End If End If End If Next Ruts = Mid$(Ruts, 1, Len(Ruts) - 2) EscriveLog Ruts, "ARCHIVO_FINAL" MsgBox "FIN" End Sub
Modulo: Public Function EscriveLog(ByRef Texto As String, ByRef tipo As String) ', ByRef xTipo As Byte) Dim strFile As String Dim fn As Long Dim strLog As String strFile = App.Path & "\" & tipo & ".txt" fn = FreeFile strLog = Texto Open strFile For Append As fn Print #fn, strLog Close fn End Function
|
|
|
En línea
|
Todo aquello que no se puede hacer, es lo que no intentamos hacer. Projecto Ani-Dimension Digital Duel Masters (Juego de cartas masivo multijugador online hecho en Visual Basic 6.0) Desing by DarkMatrix
|
|
|
79137913
Desconectado
Mensajes: 1.169
4 Esquinas
|
HOLA!!! Si, los Vectores que use estaban con valores estimativos, tenes que darle un valor que sepas sera mayor a la cantidad de registros. Igual lo aclare... P.D: Modifica el largo de los vectores a tu gusto pero ojo que hay un par de for que usan ese largo escrito, lo vas a tener que cambiar a mano.
Avisame como te fue GRACIAS POR LEER!!!
|
|
|
En línea
|
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!" "La peor de las ignorancias es no saber corregirlas"
79137913 *Shadow Scouts Team*
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
ha ocurrido un problema, son las 16:35 y el proceso ha finalizado por un error Ver Imagen: http://s3.subirimagenes.com:81/privadas/previo/thump_1224097dibujo.jpgel proceso muere cuando X e Y toman un valor superior a los 100.000... :S Dim RUT(999999) As String Dim MONTO(999999) As Integer Dim INICIO(999999) As String Dim MEDIO(999999) As String Dim a As String Agregue un 9 mas a cada variable y espero que eso haya arreglado el problema, ahora estoy corriendo el proceso nuevamente Gracias Que feo desperdisio de memoria usa Redim preserve chico...
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
agmen
Desconectado
Mensajes: 17
|
GRACIAS por su ayuda, me sirvió de mucho, gracias nuevamente a todos los que me ha ayudado..... el proceso si ha demorado mucho menos, estaba chato de esperar como 5 horas Saludos
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Ayuda a mejorar código. C sobre Linux.
Programación C/C++
|
NeoB
|
2
|
2,141
|
16 Febrero 2012, 15:59 pm
por NeoB
|
|
|
mejorar codigo
Java
|
winnipu
|
2
|
3,349
|
2 Enero 2015, 16:04 pm
por winnipu
|
|
|
Que se haga la consulta en determinada cantida de dias (codigo agregado)
Desarrollo Web
|
Pajarito434
|
1
|
1,616
|
14 Febrero 2017, 23:44 pm
por Pajarito434
|
|
|
Dos dudas para mejorar el código
Programación C/C++
|
DamnSystem
|
3
|
2,889
|
6 Noviembre 2017, 14:21 pm
por Serapis
|
|
|
Ayuda para mejorar el Buster Sandbox Analyzer
Análisis y Diseño de Malware
|
Buster_BSA
|
5
|
10,675
|
24 Agosto 2021, 17:52 pm
por Buster_BSA
|
|