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

#16 KL
09/02/2006 - 19:15 | Informe spam
Has cambiado algo en el codigo? A mi no me da el error.

KL


"Txer" wrote in message news:
Hola!

Me he dado cuenta de que en los dos últimos códigos que has escrito
al ejecutarlo sobre un libro nuevo da un error en:

Error 1004.
La referencia de ordenación no es válida. Compruebe que está dentro
de los datos que desea ordenar y que el primer cuadro de Ordenar por no
es el mismo o está en blanco.

.Sort _
Key1:=Range("B1"), _
Order1:=xlAscending, _
Header:=xlYes, _
Orientation:=xlLeftToRight

Si le doy a continuar parece que acaba bien.

Gracias
Respuesta Responder a este mensaje
#17 KL
09/02/2006 - 21:11 | Informe spam
Huff! Prueba este:

'-Inicio Codigo--
Option Explicit
Option Base 1

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

Sub principal()
Dim sBusc As String, 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
sBusc = Dir(sRuta & sFiltro)
If sBusc = "" Then GoTo Salida
ReDim vLista(1)
Do While sBusc <> ""
vLista(UBound(vLista)) = sBusc
ReDim Preserve vLista(UBound(vLista) + 1)
sBusc = Dir()
Loop
ReDim Preserve vLista(UBound(vLista) - 1)

'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) * 50
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) = "'" & lCont * 50 & "+"

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
#18 Txer
14/02/2006 - 11:26 | Informe spam
Hola de nuevo!

Ya lo siento, pero ahora que pensaba que todo iba bien, me doy cuenta
de que desde el segundo código que me facilitaste en el post 10 está
haciendo mal las medias. No he podido mirar las diferencias entre ese
código y el del post 5 que las hacía correctamente pero estoy en
ello, supongo que tú te podrás dar cuenta más fácilmente, si tienes
tiempo y lo detectas por favor dímelo.

Muchas Gracias

Txer
Respuesta Responder a este mensaje
#19 KL
14/02/2006 - 21:08 | Informe spam
Hola Txer,

Por favor enviame el archivo *.xls y unos dos o tres *.txt para hacer pruebas al correo electronico (quitando NOSPAM y PLEASE).

Saludos,
KL


"Txer" wrote in message news:
Hola de nuevo!

Ya lo siento, pero ahora que pensaba que todo iba bien, me doy cuenta
de que desde el segundo código que me facilitaste en el post 10 está
haciendo mal las medias. No he podido mirar las diferencias entre ese
código y el del post 5 que las hacía correctamente pero estoy en
ello, supongo que tú te podrás dar cuenta más fácilmente, si tienes
tiempo y lo detectas por favor dímelo.

Muchas Gracias

Txer
Respuesta Responder a este mensaje
#20 Txer
15/02/2006 - 11:17 | Informe spam
Arreglado!

Era una chorrada en la línea:

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

con cambiar 50 por 500 solucionado.

Por otro lado el último rango ponía 750+, lo cual no era correcto, he
sustituido:

'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) = "'" & lCont * 50 & "+"

por

'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 & "+"

y listo.

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).
Por otro lado, es facil hacer que la macro te pida la ruta de los
ficheros. Y otra, como se le dice en VBA que me seleccione todos los
datos de la hoja para hacer gráficos?

Gracias
Respuesta Responder a este mensaje
Ads by Google
Help Hacer una preguntaSiguiente AnteriorRespuesta Tengo una respuesta
Search Busqueda sugerida