Calculo de variables

07/07/2005 - 20:15 por carloshernandezy | Informe spam

Hola a todos,

estoy empezando a trabajar con una macro que he heredado en mi trabajo,
lo que hace es calcular la media, número de medidas de un rango, la
desviación y el CV%, en función de la fecha y da los resultados por
día. Esta macro se ejecuta todos los lunes con lo que ordena los datos
debejo de su columna por fecha de lunes a viernes.

El código funciona correctamente pero necesitaría que recalculara los
parámetros en caso de que se eliminase algún dato el rango es
variable pero nunca tiene más de 3500 valores.

En la columna "A" estan las fechas y en la "C" los datos para calcular.

Gracias

Cells(2, 4).Value = "Fecha"
Cells(3, 4).Value = "Media"
Cells(4, 4).Value = "Numero Medidas"
Cells(5, 4).Value = "Desviacion"
Cells(6, 4).Value = "CV"
Cells(1, 5).Value = "Lunes"
Cells(1, 6).Value = "Martes"
Cells(1, 7).Value = "Miercoles"
Cells(1, 8).Value = "Jueves"
Cells(1, 9).Value = "Viernes"
Cells(1, 10).Value = "Sabado"
Cells(1, 11).Value = "Domingo"
Range("e5:k6").Select
Selection.NumberFormat = "0.00"
Range("e4:k4").Select
Selection.NumberFormat = "0"
Range("e3:k3").Select
Selection.NumberFormat = "0.0"
Range("e2:k2").Select

Dim sum, Med, Des, cuent
sum = 0
Med = 0
Des = 0
x = 5
For i = 1 To 3500
Cells(i, 1).Select
A = ActiveCell.Value

For n = i + 1 To 3500
Cells(n, 1).Select
b = ActiveCell.Value

If b <> A Then
Range(Cells(i, 3), Cells(n - 1, 3)).Select
Set rng = Selection
sum = WorksheetFunction.sum(rng)
Med = WorksheetFunction.Average(rng)
Des = WorksheetFunction.StDev(rng)
cuent = WorksheetFunction.Count(rng)

Cells(2, x).Value = A
'Cells(3, x).Value = sum
Cells(3, x).Value = Med
Cells(4, x).Value = cuent
Cells(5, x).Value = Des
Cells(6, x).Value = Des * 100 / Med

x = x + 1
i = n - 1
GoTo Salta
Else
End If
'End If

Next n
Salta:
If b = "" Then
GoTo fin:
End If
Next i
fin:

Siga el debate

4 respuestas

Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#1 Héctor Miguel

08/07/2005 - 09:14 | Informe spam

hola, carlos !

... macro que he heredado... calcular la media, numero de medidas... la desviacion y el CV%
... se ejecuta todos los lunes... ordena los datos debajo de su columna por fecha de lunes a viernes.
... funciona correctamente... necesitaria que recalculara los parametros en caso... se eliminase algun dato
... el rango es variable pero nunca tiene mas de 3500 valores... columna "A"... las fechas y en la "C" los datos

1) dado que la macro NO 'deposita' formulas en las celdas, sino [solo] los valores 'resultantes' de los calculos...
[probablemente] lo 'ideal' sera que se ejecute [automaticamente] usando los eventos de la hoja [como el '_change']
2) como no 'especificas' si por 'eliminar un dato' te refieres a eliminar la fila completa o solo 'borrar' un dato...
[es posible que] se necesitara utilizar el evento '_calculate' [ya que no hay evento que 'detecte' eliminar filas] :-(
3) si la 'ejecucion' de la macro te esta resultando [supongo un poquitin...] lenta -?- podrias 'agilizar' el proceso si...
-> 'suprimes' la actualizacion de la pantalla ->Application.ScreenUpdating = False<- al inicio de la macro y...
-> sustituyes la continua 'seleccion' de celdas y rangos [durante los 'avances' de la macro por los bucles] :))
4) haz una prueba con el codigo que te expongo al final [es 'similar' al tuyo con una ligera 'adelgazada/depurada/...]
[en las pruebas que realice, hace 'exactamente' lo mismo que el codigo original] :))
5) solo 'tengo' las siguientes 'observaciones' [por algunos 'supuestos' que tuve que atribuirme] :-(
a) la fila 1 [A1 y C1] 'necesito' que sean titulos
b) los datos NO necesitan estar 'ordenados' [en sus fechas] PERO SI 'necesito' que la fecha1 [A2] sea la del lunes :))
c) no importa cuantas filas haya en total, el codigo 'busca' cual es la ultima fila 'ocupada' en la columna 'A'

si cualquier duda [o informacion adicional]... comentas?
saludos,
hector.
en un modulo de codigo 'normal' ==Sub Evaluando()
Application.ScreenUpdating = False
Dim Col As Byte, Fechas As String, Valores As String
Range("d2:d6") = Application.Transpose(Array("Fecha", "Media", "Numero Medidas", "Desviacion", "CV"))
Range("e1:k1") = Array("Lunes", "Martes", "Miercoles", "Jueves", "Viernes", "Sabado", "Domingo")
Range("e3:k3").NumberFormat = "0.0"
Range("e4:k4").NumberFormat = "0"
Range("e5:k6").NumberFormat = "0.00"
Range("a2").Copy Range("e2")
Range("e2").AutoFill Range("e2:k2"), xlFillDays
Fechas = "a2:a" & Range("a65536").End(xlUp).Row
Valores = "c2:c" & Range("a65536").End(xlUp).Row
For Col = 5 To 11
Cells(4, Col) = Evaluate("CountIf(" & Fechas & "," & Cells(2, Col).Address & ")")
Cells(3, Col) = Evaluate("SumIf(" & Fechas & "," & Cells(2, Col).Address & "," & Valores & ")") / Cells(4, Col)
Cells(5, Col) = Evaluate("StDev(If(" & Fechas & "=" & Cells(2, Col).Address & "," & Valores & ",""""""""))")
Cells(6, Col) = Cells(5, Col) * 100 / Cells(3, Col)
Next
End Sub

Responder a este mensaje

#2 carloshernandezy

08/07/2005 - 17:36 | Informe spam

Muchas gracias por tu rápida respuesta y tu código funciona y realiza
la misma función pero en caso de que se salte algún día la columna
el código falla Run Time Error "6" Overflow supongo que espera que los
días sean fechas consecutivas.

La ejecución es lenta ya que son muchos valores y esta concatenada a
otra en la que se eliminan valores innecesarios para el cálculo,
podria incorporar esa condición en los CountIF, SumIf. Elimino las
filas que contienen valores inferiores a 0 en la columna "C".

For i = 0 To 7000 'Elimina los valores inferiores a 0 de la 3ª Columna
de TOC (PW)

Application.ScreenUpdating = False
n = 1 + i
Cells(n, 3).Select
A = ActiveCell.Value
If A < 0 Then
Rows(n).Delete
i = i - 1
Else
End If
Next i
Call Calcula

MUchas Gracias

Responder a este mensaje

#3 Héctor Miguel

08/07/2005 - 22:17 | Informe spam

hola, carlos !

... tu codigo funciona y realiza la misma funcion
... en caso de que se salte algun dia... falla Run Time Error "6" Overflow
... supongo que espera que los dias sean fechas consecutivas.
... ejecucion... lenta... son muchos valores y... concatenada a otra
... se eliminan... las filas que contienen valores inferiores a 0 en la columna "C".
For i = 0 To 7000 'Elimina los valores inferiores a 0 de la 3ª Columna de TOC (PW)
Application.ScreenUpdating = False
n = 1 + i
Cells(n, 3).Select
A = ActiveCell.Value
If A < 0 Then
Rows(n).Delete
i = i - 1
Else
End If
Next i
Call Calcula

1) [efectivamente]... el codigo NO 'espera' que alguna fecha quede 'falta de datos' [o informacion] :-(
2) la 'lentitud' en la ejecucion ['insisto']... se debe a la 'constante' [y continua] re/seleccion de la celda activa [Cells(x,y).Select] :-(
[y no en la 'parte' que efectua -y 'deposita'- el resultado de los calculos... sino en la parte que 'va eliminando' las <0] :-(
[y... si le agregamos que la eliminacion esta 'buscando' -y 'regresandose'- +/- en 7000 filas..] <\°|°/>
3) no se que mas 'cosillas' se pudieran estar 'quedando en el tintero' :)) pero... con los datos 'conocidos' hasta el momento...
-> la siguiente 'propuesta' y 'como si se tratara' del UNICO proceso a efectuarse...
[probada con 6000 'registros'] se ha tardado 'cosa de... un suspiro' :))
4) no me queda 'claro' si necesitas eliminar las filas cuyo valor en 'C' sea <0 [con lo que 'se conservan' las que sean cero]
o... se incluyen las que sean cero [con lo que la 'comparacion' se modifica a <=0]
-> revisa/valida/modifica/... la linea que 'dice'... ->Elimina = Evaluate("CountIf(c:c,""<0"")")<- <= OJO

haz algunas pruebas y... si cualquier duda [o informacion adicional]... comentas?
saludos,
hector.
en un modulo de codigo 'normal' ==Sub Evaluando()
Application.ScreenUpdating = False
Dim Elimina As Integer, Col As Byte, Fechas As String, Valores As String, Cuenta As Integer
Columns("a:c").Sort Key1:=Range("c1"), Order1:=xlAscending, Header:=xlYes
Elimina = Evaluate("CountIf(c:c,""<0"")")
If Elimina > 0 Then Range("a2:a" & Elimina + 1).EntireRow.Delete
Columns("a:c").Sort Key1:=Range("a1"), Order1:=xlAscending, Header:=xlYes
Range("d2:d6") = Application.Transpose(Array("Fecha", "Media", "Numero Medidas", "Desviacion", "CV"))
Range("e1:k1") = Array("Lunes", "Martes", "Miercoles", "Jueves", "Viernes", "Sabado", "Domingo")
Range("e3:k3").NumberFormat = "0.0"
Range("e4:k4").NumberFormat = "0"
Range("e5:k6").NumberFormat = "0.00"
Range("a2").Copy Range("e2")
Range("e2").AutoFill Range("e2:k2"), xlFillDays
Fechas = "a2:a" & Range("a65536").End(xlUp).Row
Valores = "c2:c" & Range("a65536").End(xlUp).Row
For Col = 5 To 11
Cuenta = Evaluate("CountIf(" & Fechas & "," & Cells(2, Col).Address & ")")
If Cuenta > 0 Then
Cells(4, Col) = Cuenta
Cells(3, Col) = Evaluate("SumIf(" & Fechas & "," & Cells(2, Col).Address & "," & Valores & ")") / Cells(4, Col)
Cells(5, Col) = Evaluate("StDev(If(" & Fechas & "=" & Cells(2, Col).Address & "," & Valores & ",""""""""))")
Cells(6, Col) = Cells(5, Col) * 100 / Cells(3, Col)
End If
Next
End Sub

Responder a este mensaje

#4 carloshernandezy

09/07/2005 - 15:22 | Informe spam

Insisto Héctor muchas gracias, con esta modificación final el código
es rápido y realiza las funciones que yo esperaba.

Gracias

Siga el debate Respuesta

Responder a este mensaje

Ads by Google

Hacer una pregunta

Tengo una respuesta

Busqueda sugerida