Todo un reto!

Hola Txer,

El macro que dices haber grabado nos daria muchisima mas informacion que 10 explicaciones, no crees?

Saludos,
KL


"Txer" wrote in message news:
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.

Podria ser algo asi, por ejemplo (habria que adaptarlo a tu uso
particular)

' se asume option base 0
dim rangos as variant
dim suma() as single
dim cuantos() as integer
dim n as integer
dim f as integer, i as integer
dim pot as single, vibr as single

' se asume que el primer rango es de 0 al primer valor y el ultimo
rango
' van los mayores que el ultimo
rangos=array(500,1000,1200,1500,3000)
n=ubound(rangos)+1
redim suma(n+1),cuantos(n+1)
f=1
' se asume potencias en columna 1 y empiezan en fila 1
' no pueden haber vacios
do until cells(f,1)=""
pot=cells(f,1).value
vibr=cells(f,2).value

if pot>rangos(n-1) then
suma(n+1)=suma(n+1)+vibr
cuantos(n+1)=cuantos(n+1)+1
else
for i=1 to n
if pot<=rangos(i-1) then
suma(i)=suma(i)+vibr
cuantos(i)=cuantos(i)+1
exit for
end if
next
end if
f=f+1
loop

' se asume que existe la hoja con ese nombre y esta vacia
worksheets("resumen").activate
cells(1,1).value="rangos"
cells(1,2).value="numero"
cells(1,3).value="suma"
cells(1,4).value="promedio"
for i=1 to n+1

if i=1 then
cells(i+1,1).value="pot <= " & rangos(i-1)
elseif i=n+1 then
cells(i+1,1).value="pot > " & rangos(i-1)
else
cells(i+1,1).value=rangos(i-2) & " < pot <= " & rangos(i-1)
end if

cells(i+1,2).value=cuantos(i)
cells(i+1,3).value=suma(i)
if cuantos(i)>0 then
cells(i+1,4).value=suma(i)/cuantos(i)
else
cells(i+1,4)="N/A"
end if
next

espero te sirva

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.

Bueno, si sirve de aclaración os pongo el código que obtuve. No
obstante, el código implica abrir unos archivos de texto y realizar un
proceso, en principio la tarea de abrir los archivos de texto la
podría hacer yo, lo que más me interesa es conseguir una macro para
que procese los datos. Ahí va!

Sub Ejemplo()
'
' Ejemplo Macro
' Macro grabada el 29/01/2006 por Txer
'

'
' Escribo la fecha de los datos que importaré después como encabezado
de las dos columnas
Range("A1").Select
ActiveCell.FormulaR1C1 = "5/18/2005"
Range("A1:B1").Select
Range("B1").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
' Abro el fichero de datos e importo las columnas de Potencia y
vibración
Range("A2").Select
ChDir "C:\Canal_2"
Workbooks.OpenText Filename:= _
"C:\Canal_2\PV01A01H2_180505.txt", _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, _
Comma:=False, Space:=False, Other:=False,
FieldInfo:=Array(Array(1, 9), _
Array(2, 1), Array(3, 1))
' Selecciono y copio las dos columnas de datos
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
' Las pego en la Hoja 1 del libro en el que voy a trabajar en la
primera celda disponible
Windows("Libro2").Activate
Range("A2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' Ordeno las columnas en función de la primera (potencia)
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' Selecciono las celdas de potencia y vibración cuyo valor de potencia
es cero y las borro
Range("A2:B802").Select
Selection.Delete Shift:=xlUp
' En una nueva hoja (hoja 2) creo los encabezados de fila con los
rangos de potencia
Sheets("Hoja2").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "0-499"
Range("A3").Select
ActiveCell.FormulaR1C1 = "500-999"
Range("A4").Select
ActiveCell.FormulaR1C1 = "1000-1499"
Range("A5").Select
ActiveCell.FormulaR1C1 = "1500-1999"
Range("A6").Select
ActiveCell.FormulaR1C1 = "2000-2499"
Range("A7").Select
ActiveCell.FormulaR1C1 = "2500-2999"
Range("A8").Select
ActiveCell.FormulaR1C1 = "3000-3499"
Range("A9").Select
ActiveCell.FormulaR1C1 = "3500-3999"
Range("A10").Select
ActiveCell.FormulaR1C1 = "4000-4499"
Range("A11").Select
ActiveCell.FormulaR1C1 = "4500-4999"
Range("A12").Select
ActiveCell.FormulaR1C1 = "5000-5499"
Range("A13").Select
ActiveCell.FormulaR1C1 = "5500-5999"
Range("A14").Select
ActiveCell.FormulaR1C1 = "6000-6499"
Range("A15").Select
ActiveCell.FormulaR1C1 = "6500-6999"
Range("A16").Select
ActiveCell.FormulaR1C1 = "7000-7499"
' Creo el encabezado de columna con la fecha de los datos
Range("B1").Select
ActiveCell.FormulaR1C1 = "5/18/2005"
' Hago los promedios de los valores de vibracíón en cada rango de
potencia
Range("B2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!RC:R[122]C)"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[122]C:R[368]C)"
Range("B4").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[368]C:R[755]C)"
Range("B5").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[755]C:R[1283]C)"
Range("B6").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[1283]C:R[1677]C)"
Range("B7").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[1677]C:R[1917]C)"
Range("B8").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[1917]C:R[2164]C)"
Range("B9").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[2164]C:R[2401]C)"
Range("B10").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[2401]C:R[2635]C)"
Range("B11").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[2635]C:R[2980]C)"
Range("B12").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[2980]C:R[3135]C)"
Range("B13").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[3135]C:R[3337]C)"
Range("B14").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[3337]C:R[3670]C)"
Range("B15").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[3670]C:R[3962]C)"
Range("B16").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[3962]C:R[4608]C)"
' Vuelvo a la hoja 1
Sheets("Hoja1").Select
ActiveWindow.ScrollRow = 1
' Añado el encabezado de columna para otro día
Range("C1").Select
ActiveCell.FormulaR1C1 = "5/25/2005"
Range("C1:D1").Select
Range("D1").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
' Me posiciono en la siguiente celda donde voy a pegar las nuevas
columnas
Range("C2").Select
' Abro el nuevo archivo de texto
Workbooks.OpenText Filename:= _
"C:\Canal_2\PV01A01H2_250505.txt", _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, _
Comma:=False, Space:=False, Other:=False,
FieldInfo:=Array(Array(1, 9), _
Array(2, 1), Array(3, 1))
' Vuelvo a seleccionar las dos columnas de datos
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Libro2").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
' Las vuelvo a ordenar
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' Selecciono las que son cero y las borro
Range("C2:D985").Select
Selection.Delete Shift:=xlUp
' Cambio a la Hoja 2
Sheets("Hoja2").Select
' Creo el encabezado con la nueva fecha para hacer los promedios
Range("C1").Select
ActiveCell.FormulaR1C1 = "5/25/2005"
' Hago los promedios
' En este caso no hay valores de potencia para todos los rangos así
que esos no se rellenan
Range("C2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!RC[1]:R[1310]C[1])"
Range("C3").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[1310]C[1]:R[1992]C[1])"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[1992]C[1]:R[2672]C[1])"
Range("C5").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[2672]C[1]:R[3256]C[1])"
Range("C6").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[3256]C[1]:R[3744]C[1])"
Range("C7").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[3744]C[1]:R[4084]C[1])"
Range("C8").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[4084]C[1]:R[4293]C[1])"
Range("C9").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[4293]C[1]:R[4384]C[1])"
Range("C10").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(Hoja1!R[4384]C[1]:R[4431]C[1])"
Windows("Libro2").Activate
Range("D1").Select
ActiveCell.FormulaR1C1 = "6/1/2005"
Sheets("Hoja1").Select
ActiveWindow.ScrollRow = 1
Range("E1").Select
ActiveCell.FormulaR1C1 = "6/1/2005"
Range("E1:F1").Select
Range("F1").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Range("E2").Select
'Y así seguiriamos hasta procesar todos los datos
End Sub

A ver si me podéis ayudar. Muchas Gracias

Yo lo haria de la siguiente forma:

En la hoja 1 colocaría los datos en columnas: Fecha, Potencia,
Vibración y añadiría otra columna calculada que sería Rango. Esta
columna la calcularía (si los rangos los vas a hacer de 500 en 500)
algo así =entero(Potencia/500)*500

Con esta tabla hecha en la hoja 1 me crearia una tabla dinamica con
columnas las fechas, en filas el rango y en el cálculo el promedio de
Vibración.

Creo que será lo más sencillo.

Hola Txer,

Creo que yo lo haria de la siguiente manera.

Saludos,
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 * 500
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.Offset(2, 1)
.Resize(, UBound(vLista) + 1) _
.AutoFill .Resize(lCat, UBound(vLista) + 1)
'Ajustamos el ancho de columnas
.Parent.UsedRange.EntireColumn.AutoFit
End With
'Eliminamos formulas
With oCelda2.Resize(lCat + 1, UBound(vLista) + 2)
.Value = .Value
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--