Todo un reto!

01/02/2006 - 17:30 por Txer | Informe spam

Os expongo mi reto, yo usé la grabadora de macros para intentar
evolucionar a partir de ahí pero el código se refiere a las celdas
usadas en ese momento y que yo seleccioné usando "mi cabeza" lo que
quiero es que Excel lo haga por mi.

Parto de dos columnas de datos con cerca de 4000 valores cada una
(puede variar) en una hoja de Excel (hoja 1).La columna primera es
Potencia (de 0 a 7500 aprox.) la segunda Vibración (de 200 a 400
aprox.), las dos columnas están relacionadas, a cada potencia hay un
nivel de vibración.

En primer lugar lo que hago es borrar los valores de potencia y
vibración en los cuales el valor de potencia es cero, para ello ordeno
las dos columnas en función de la columna de potencia, selecciono
todas las que son cero y las borro (tanto la celda de potencia como la
de vibración).

Para el segundo paso en primer lugar y en otra hoja (hoja 2) creo unos
encabezados de fila con los rangos de potencia que me interesan (0-499,
500-999, 1000-1499...hasta 6500-7500) y a la derecha de cada rango
quiero poner la media de los valores de vibración correspondientes a
todos los valores de potencia contenidos en ese rango de la hoja 1.
Para ello uso la función PROMEDIO y selecciono a mano todos los
valores de vibración correspondientes a los valores de potencia
comprendidos entre 0-499, 500-999, 1000-1499, etc...
Con esto lo habría hecho para un día pongamos el 1 de Agosto de 2005.
A continuación lo debería de hacer para el 5 de Septiembre, el 8 de
Octubre, o la fecha que sea.

Para ello pongo otras dos columnas de datos (las obtengo de archivos de
texto con los valores separados por tabulación) a continuación de las
primeras y hago todo el proceso de la hoja 1 y luego el de la hoja 2.
Los valores medios de vibración los pongo en la siguiente columna de
la hoja 2, poniendole a cada columna la fecha como encabezado.
Y así hasta que haya procesado todos los datos.

Yo he conseguido ordenar la columna y borrar los valores iguales a cero
pero el tema de seleccionar según los rangos de potencia, etc..se me
escapa, he intentado cosas pero sin éxito, no se como hacer en código
que salte a la columna siguiente vuelva a ordenar y borrar y haga lo
mismo con las medias y demás..

Si alguno dominais y me podeis ayudar os lo agradecería en el alma.

Siga el debate

25 respuestas

Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#6 Txer

07/02/2006 - 18:12 | Informe spam

Hola KL!

Ante todo mil gracias por tu código, cuando conseguí ejecutarlo
hacía lo que yo quería. Te digo esto porque ahora estoy intentándolo
y no hay manera de conseguirlo. Me da el error siguiente al pararse en
la subrutina Importar Datos en la línea que pone Refresh.

Se ha producido el erro 1004 en tiempo de ejecución:
No se puede encontrar el archivo de texto para actualizar este rango de
datos externos
Compruebe que no se haya cambiado el nombre del archivo de texto o que
no se haya movido y vuelva a intentar realizar la actualización.

Ni he renombrado los archivos ni he los he movido, de hecho ya te digo
que antes ya lo logre ejecutar pero ahora no se que hago mal. Yo
inserto un nuevo módulo en una hoja de un libro y pego el código.
Luego lo intento ejecutar desde la hoja excel pero siempre me da ese
error.

Estoy mirando en la base de datos de microsoft y puede que sea un fallo
del office que se corrige instalando el SP3, lo miro y te cuento, igual
te pido consejo para añadir alguna cosilla.

Muchas Gracias

Txer

Responder a este mensaje

#7 Txer

07/02/2006 - 18:37 | Informe spam

Pues va a ser que no! He probado un ordenador con el SP3 y me sigue
fallando.
Si se te ocurre algo por favor me lo cuentas, seguiré investigando

Saludos

Txer

Responder a este mensaje

#8 KL

07/02/2006 - 21:09 | Informe spam

Hola Txer,

Creo que lo que ha pasado en algun momento es que se ha cortado el codigo a medias antes de que se ejecutara el metodo Delete y se
ha quedado la consulta (query) colgada en la hoja. Prueba eleminar todos los datos introducidos por la ejecucion anterior del macro
(filas o columnas enteras) y volver a ejecutar el codigo.

Saludos,
KL

"Txer" wrote in message news:
Hola KL!

Ante todo mil gracias por tu código, cuando conseguí ejecutarlo
hacía lo que yo quería. Te digo esto porque ahora estoy intentándolo
y no hay manera de conseguirlo. Me da el error siguiente al pararse en
la subrutina Importar Datos en la línea que pone Refresh.

Se ha producido el erro 1004 en tiempo de ejecución:
No se puede encontrar el archivo de texto para actualizar este rango de
datos externos
Compruebe que no se haya cambiado el nombre del archivo de texto o que
no se haya movido y vuelva a intentar realizar la actualización.

Ni he renombrado los archivos ni he los he movido, de hecho ya te digo
que antes ya lo logre ejecutar pero ahora no se que hago mal. Yo
inserto un nuevo módulo en una hoja de un libro y pego el código.
Luego lo intento ejecutar desde la hoja excel pero siempre me da ese
error.

Estoy mirando en la base de datos de microsoft y puede que sea un fallo
del office que se corrige instalando el SP3, lo miro y te cuento, igual
te pido consejo para añadir alguna cosilla.

Muchas Gracias

Txer

Responder a este mensaje

#9 Txer

08/02/2006 - 17:29 | Informe spam

Hola de nuevo!

Bueno el tema del error 1004 solucionado, en realidad si que había
movido algo, estaba ejecutando el macro en un archivo fuera de la
carpeta donde estaban los txt, para solucionarlo le he añadido SRuta
en la subrutina de Importar datos.

Si que tengo otras dudas:
Estoy intentado que en vez de poner los rangos como 0, 500, 1000...etc.
me los ponga dividos por 10 (que es su verdadero valor) y además
indicando el rango 0-49, 50-99, 100-149...lo he intentado de varias
maneras y la que mejor funciona es añadiendo:

Salida:
'Descongelamos la pantalla
Application.ScreenUpdating = True

'NUEVO BUCLE QUE AÑADO PARA QUE LOS RANGOS SEAN DEL TIPO 0-49,
50-99...
For lCont = 0 To (lCat)
'Creamos de nuevo los titulos de filas en hoja 2
oCelda2.Offset(lCont + 1) = lCont * 50 & "-" & Str((lCont * 50)
+ 49)
Next lCont
'Ajustamos de nuevo el ancho de columnas
oCelda2.EntireColumn.AutoFit

El problema es que hace todo bien excepto los valores medios
correspondientes al último rango de 700-749 (antiguamente de
7000-7499), me dice que es una división por cero.
Me gustaría también ajustar los valores medios de vibración que
debería dividirlos entre 100, pero esto ya no se si sería muy
complicado.

Al hilo de esto, ¿se podría hacer que en vez de salir #!DIV/0¡ no
rellenara la casilla con nada si no hay valores para calcular? el tema
es que con los valores obtenidos en la hoja 2 trazo unos graficos de
tendencia y los DIV/0 me tiran el gráfico a cero y los estropean.

Mil Gracias

Txer

Responder a este mensaje

#10 KL

09/02/2006 - 12:49 | Informe spam

Hola Txer,

A ver que tal el codigo que te pongo a continuacion.

KL

'-Inicio Codigo--
Option Explicit

Const sRuta = "C:\CANAL_2\" 'ruta hacia los ficheros de texto
Const sFiltro = "*.txt" 'filtro, otro ejemplo: "PV01A01H2_*.txt"
Const lCat = 14 'numero de rangos/categorias a crear en hoja 2

Sub principal()
Dim sBusc As String
Dim sArchivo As String
Dim sTxt As String
Dim sRng1 As String
Dim sRng2 As String
Dim lCont As Long
Dim vLista As Variant
Dim dtFecha As Date
Dim oCelda1 As Range
Dim oCelda2 As Range

'Establecemos las variables
sBusc = Dir(sRuta & sFiltro)
Set oCelda1 = ThisWorkbook.Sheets(1).Range("A1")
Set oCelda2 = ThisWorkbook.Sheets(2).Range("A1")

'Sacamos la lista de los ficheros de texto
If sBusc = "" Then GoTo Salida
ReDim vLista(0)
Do While sBusc <> ""
vLista(UBound(vLista)) = sBusc
ReDim Preserve vLista(UBound(vLista) + 1)
sBusc = Dir()
Loop
ReDim Preserve vLista(UBound(vLista) - 1)

'Congelamos la pantalla
Application.ScreenUpdating = False

'Preparamos las hojas
'Limpiamos ambas hojas
oCelda1.Parent.Cells.ClearContents
oCelda2.Parent.Cells.ClearContents
For lCont = 0 To lCat
'Creamos los titulos de filas en hoja 2
oCelda2.Offset(lCont + 1) = lCont * 50
Next lCont

'Procesamos todos los ficheros de texto extraidos
For lCont = LBound(vLista) To UBound(vLista)
'asignamos el nombre y la ruta a una variable
sArchivo = vLista(lCont)
'Extraemos la cadena de texto de la fecha
sTxt = Left(Right(sArchivo, 10), 6)
'Convertimos el texto en formato fecha
dtFecha = DateSerial(Right(sTxt, 2), _
Mid(sTxt, 3, 2), Left(sTxt, 2))
'Ponemos los encabezados en hoja 2
oCelda2.Offset(, lCont + 1) = dtFecha
'Importamos las columnas 2 y 3 de cada fichero de texto
'llamando el procedimiento "ImportarDatos" que esta
'debajo de este procedimiento y que require dos
'parametros: nombre completo del fichero (incl. ruta)
'y el objeto celda donde se van a introducir los datos.
ImportarDatos sArchivo, oCelda1.Offset(, 2 * lCont)
Next lCont

'Creamos la fromula del primer rango que excluye 0.
For lCont = 0 To UBound(vLista)
'rango a evaluar
sRng1 = _
oCelda1.Offset(, lCont * 2).EntireColumn. _
Address(, True, xlA1, True)
'rango a sumar
sRng2 = _
oCelda1.Offset(, lCont * 2 + 1).EntireColumn. _
Address(, True, xlA1, True)
oCelda2.Offset(1, lCont + 1) = _
"=(SUMIF(" & sRng1 & ","">""&$A2," & sRng2 & ")-SUMIF(" _
& sRng1 & ","">=""&$A3," & sRng2 & "))/(COUNTIF(" _
& sRng1 & ","">""&$A2)-COUNTIF(" & sRng1 & _
","">=""&$A3))"
Next lCont

'Creamos el resto de las formulas
For lCont = 0 To UBound(vLista)
'rango a evaluar
sRng1 = _
oCelda1.Offset(, lCont * 2).EntireColumn. _
Address(, True, xlA1, True)
'rango a sumar
sRng2 = _
oCelda1.Offset(, lCont * 2 + 1).EntireColumn. _
Address(, True, xlA1, True)
oCelda2.Offset(2, lCont + 1) = _
"=(SUMIF(" & sRng1 & ","">=""&$A3," & sRng2 & ")-SUMIF(" _
& sRng1 & ","">=""&$A4," & sRng2 & "))/(COUNTIF(" _
& sRng1 & ","">=""&$A3)-COUNTIF(" & sRng1 & _
","">=""&$A4))"
Next lCont

'Copiamos las formulas
With oCelda2
With .Offset(2, 1)
.Resize(, UBound(vLista) + 1) _
.AutoFill .Resize(lCat, UBound(vLista) + 1)
End With
'Eliminamos formulas
With .Parent.UsedRange
.Value = .Value
End With
'Modificamos los titulos de filas
.Offset(1) = "'1-49"
For lCont = 1 To lCat
'Creamos los titulos de filas en hoja 2
.Offset(lCont + 1) = "'" & lCont * 50 & _
"-" & (lCont + 1) * 50 - 1
Next lCont
.Offset(lCont) = "'" & lCont * 50 & "+"
With .Parent.UsedRange
'Eliminamos errores
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors) _
.ClearContents
On Error GoTo 0
'Ajustamos el ancho de columnas
.EntireColumn.AutoFit
End With
End With
Salida:
'Descongelamos la pantalla
Application.ScreenUpdating = True
End Sub

Sub ImportarDatos(sArchivo As String, oCelda As Range)
Dim qt As QueryTable
Set qt = oCelda.Parent.QueryTables.Add("TEXT;" & sArchivo, oCelda)
With qt
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileColumnDataTypes = Array(9, 1, 1)
.Refresh
.Delete
End With
End Sub
'-Fin Codigo--

Responder a este mensaje

Ads by Google

Hacer una preguntaSiguiente

Tengo una respuesta

1 2 3 4 5

Busqueda sugerida