Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Todo un reto!

01/02/2006 - 17:30 por Txer | Informe spam
Ayuda Hacer una pregunta
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.
email Siga el debateRespuesta 25 respuestasRespuesta Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#21 KL
15/02/2006 - 21:35 | Informe spam
Hola Txer,

Estoy haciendo pruebas y veo que si que tengo un problema que es creo
que más dificil de solucionar, a partir de más o menos 100 ficheros
txt me queo sin memoria y casca (lo cual supongo que es normal).



Es normal (aparte de que si son 123 te quedaras sin columnas en todo caso). Revisa esto:

como se le dice en VBA que me seleccione todos los
datos de la hoja para hacer gráficos?



Vas a tener que explicar esto en mayor detalle :-) Se trata de la tabla que crea el codigo que hemos ido creando?

hacer que la macro te pida la ruta de los ficheros.



Prueba el codigo que te pongo a continuacion.

Saludos,
KL

'-Inicio Codigo--
Option Explicit
Option Base 1
Const lCat = 15 'numero de rangos/categorias a crear en hoja 2

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

'Sacamos la lista de los ficheros de texto
vLista = Application. _
GetOpenFilename("Text Files (*.txt), *.txt", , , , True)

If Not IsArray(vLista) Then Exit Sub
'Establecemos los rangos
Set oCelda1 = ThisWorkbook.Sheets(1).Range("A1")
Set oCelda2 = ThisWorkbook.Sheets(2).Range("A1")
Set oTabTot = oCelda2.Resize(lCat + 1, UBound(vLista) + 1)
Set oTabDat = oCelda2.Offset(1, 1).Resize(lCat, UBound(vLista))

'Congelamos la pantalla
Application.ScreenUpdating = False

'Limpiamos ambas hojas
oCelda1.Parent.Cells.ClearContents
oCelda2.Parent.Cells.ClearContents

'Creamos los titulos de filas en hoja 2
For lCont = 1 To lCat
oTabTot(lCont + 1, 1) = (lCont - 1) * 500
Next lCont

'Procesamos todos los ficheros de texto extraidos
For lCont = 1 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
oTabTot(1, lCont + 1) = dtFecha
'Importamos las columnas 2 y 3 de cada fichero de texto
ImportarDatos sArchivo, oCelda1.Offset(, 2 * (lCont - 1))
Next lCont

For lCont = 1 To UBound(vLista)
With oCelda1.Offset(, 2 * (lCont - 1)).EntireColumn
'rango a evaluar en formato texto
sRng1 = .Address(, True, xlA1, True)
'rango a sumar en formato texto
sRng2 = .Offset(, 1).Address(, True, xlA1, True)
End With
With oTabDat(1, lCont)
'Creamos las formulas
.Formula = _
"=(SUMIF(" & sRng1 & ","">=""&$A2," & sRng2 & ")-SUMIF(" _
& sRng1 & ","">=""&$A3," & sRng2 & "))/(COUNTIF(" _
& sRng1 & ","">=""&$A2)-COUNTIF(" & sRng1 & _
","">=""&$A3))"
'Copiamos las formulas
.AutoFill oTabDat.Columns(lCont)
'Creamos la fromula del primer rango que excluye 0.
.Formula = _
"=(SUMIF(" & sRng1 & ","">""&$A2," & sRng2 & ")-SUMIF(" _
& sRng1 & ","">=""&$A3," & sRng2 & "))/(COUNTIF(" _
& sRng1 & ","">""&$A2)-COUNTIF(" & sRng1 & _
","">=""&$A3))"
End With
Next lCont

With oTabDat
'Ordenamos columnas
With .Offset(-1).Resize(.Rows.Count + 1)
.Sort _
Key1:=.Cells(1), _
Order1:=xlAscending, _
Header:=xlYes, _
Orientation:=xlLeftToRight
End With
'Eliminamos formulas
.Value = .Value
'Dividimos por 100
oCelda2 = 100
oCelda2.Copy
.PasteSpecial xlValues, xlPasteSpecialOperationDivide
oCelda2 = ""
Application.CutCopyMode = False
End With

'Modificamos los titulos de filas
For lCont = 0 To lCat - 1
oTabTot(lCont + 2, 1) = "'" & lCont * 50 & _
"-" & (lCont + 1) * 50 - 1
Next lCont
oTabTot(2, 1) = "'1-49"
oTabTot(lCont + 1, 1) = "'700+"

With oTabTot
'Eliminamos errores
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents
On Error GoTo 0
'Ajustamos el ancho de columnas
.EntireColumn.AutoFit
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--
Respuesta Responder a este mensaje
#22 Txer
16/02/2006 - 09:32 | Informe spam
Hola KL,

Vale, he probado tu código y pide la ruta. Pero ahora me está venga
dar error, se para al principio en el Refresh de la subrutina de
Importar archivos me da error 1004: Error definido por la aplicación o
el objeto. También me pasa con los anteriores códigos.

Dios que coñazo!

A lo que me preguntabas si me refería a la tabla creada por el
código,si, a esa me refiero, es para trazar gráficos con los datos.
Respuesta Responder a este mensaje
#23 KL
16/02/2006 - 10:52 | Informe spam
Hola Txer,

se para al principio en el Refresh de la subrutina de
Importar archivos me da error 1004: Error definido por la aplicación o
el objeto. También me pasa con los anteriores códigos.



A mi me funciona bien la ultima version (si que he notado que a partir de cierto momento empezo a dar el error que dices porque
borre accidentalmente la variable sRuta en esta linea:

ImportarDatos sArchivo, oCelda1.Offset(, 2 * (lCont - 1))

debia ser mas bien:

ImportarDatos sRuta & sArchivo, oCelda1.Offset(, 2 * (lCont - 1))

En todo caso la nueva version no debria necesitar nada de eso a no ser que hayas cambiado algo en el ultimo codigo que te he
posteado y ne te hayas olvidado de mencionarlo :-) El codigo se ha vuelto bastante complejo y cualquier cambio/adaptacion requiere
mencion especial para entender los posibles errores. Comentas mas detalles?

Dios que coñazo!



Por mi no te preocupes que ya que estoy de todas formas...:-)

A lo que me preguntabas si me refería a la tabla creada por el
código,si, a esa me refiero, es para trazar gráficos con los datos.



Si tienes una o varias tablas en la hoja y sabes la posicion de la primera celda de la tabla, la forma mas simple es usando la
siguiente instruccion:

[A1].CerrentRegion

que devuelve el objeto rango que corresponde al area usado adyacente a la celda [A1]

Tambien, si no usas formatos en esa hoja y solo hay una tabla posible (no hay mas datos en la hoja) podrias usar:

Worksheets("Hoja1").UsedRange

Saludos,
KL
Respuesta Responder a este mensaje
#24 KL
16/02/2006 - 11:33 | Informe spam
Hola de nuevo,

He hecho pruebas con los ficheros *.txt que me has enviado y he comprobado que:

1) la ultima version que te he posteado me funciona correctamente en dos equipos diferentes con XL2000 y XL2003, siempre y cuando el
*.txt no este vacio (!)
2) si un fichero *.txt esta vacio el codigo se interrumpe dando error 7 en tiempo de ejecucion "memoria insuficiente".
3) dicho error parece que provoca un error de toda la aplicacion ya que [a veces] luego ya no permite importar ficheros buenos y hay
que reiniciar Excel. Al cerrar Excel [siempre] aparece el tipico mensaje de que "Excel ha detectado un problema y debe cerrarse..."

Voy a ver si se puede evitar procesar los archivos que no tengan datos.

Saludos,
KL

"KL" wrote in message news:%
Hola Txer,

se para al principio en el Refresh de la subrutina de
Importar archivos me da error 1004: Error definido por la aplicación o
el objeto. También me pasa con los anteriores códigos.



A mi me funciona bien la ultima version (si que he notado que a partir de cierto momento empezo a dar el error que dices porque
borre accidentalmente la variable sRuta en esta linea:

ImportarDatos sArchivo, oCelda1.Offset(, 2 * (lCont - 1))

debia ser mas bien:

ImportarDatos sRuta & sArchivo, oCelda1.Offset(, 2 * (lCont - 1))

En todo caso la nueva version no debria necesitar nada de eso a no ser que hayas cambiado algo en el ultimo codigo que te he
posteado y ne te hayas olvidado de mencionarlo :-) El codigo se ha vuelto bastante complejo y cualquier cambio/adaptacion requiere
mencion especial para entender los posibles errores. Comentas mas detalles?

Dios que coñazo!



Por mi no te preocupes que ya que estoy de todas formas...:-)

A lo que me preguntabas si me refería a la tabla creada por el
código,si, a esa me refiero, es para trazar gráficos con los datos.



Si tienes una o varias tablas en la hoja y sabes la posicion de la primera celda de la tabla, la forma mas simple es usando la
siguiente instruccion:

[A1].CerrentRegion

que devuelve el objeto rango que corresponde al area usado adyacente a la celda [A1]

Tambien, si no usas formatos en esa hoja y solo hay una tabla posible (no hay mas datos en la hoja) podrias usar:

Worksheets("Hoja1").UsedRange

Saludos,
KL



Respuesta Responder a este mensaje
#25 KL
16/02/2006 - 11:56 | Informe spam
Hola Txer,

Prueba reemplazar el macro "ImportarDatos" con este codigo.

Saludos,
KL

Sub ImportarDatos(sArchivo As String, oCelda As Range)
Dim qt As QueryTable
If FileLen(sArchivo) Then
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
Set qt = Nothing
End If
End Sub
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una pregunta AnteriorRespuesta Tengo una respuesta
Search Busqueda sugerida