Obtener un máximo cumpliendo 2 condiciones(nombre, fecha)
Tengo una base de datos con 3 columnas: Nombre, Fecha y tiempo, almacena duración de sesión por fecha.
Necesito encontrar el máximo tiempo que duro cada persona diario, para al final sumar el total de tiempo que duro por semana o por mes.
1 respuesta
Este es un ejemplo de como funciona la macro
y esta es la macro
Sub ejecuta()
maximos
totalizar
End Sub
Sub maximos()
Set funcion = WorksheetFunction
Set datos = Range("a1").CurrentRegion
With datos
f = .Rows.Count: c = .Columns.Count
.Sort _
key1:=Range(.Columns(1).Address), order1:=xlAscending, _
key2:=Range(.Columns(2).Address), order2:=xlAscending, _
key3:=Range(.Columns(3).Address), order3:=xlDescending, Header:=True
Set datos = .Rows(2).Resize(f - 1, c)
.Columns(4).Formula = "=a2 & b2"
Set datos = .Resize(f, c + 1)
f = .Rows.Count: c = .Columns.Count
Set tabla = .Columns(c + 2).Resize(f, c)
With tabla
.Columns(1).Value = datos.Columns(c).Value
.RemoveDuplicates Columns:=Array(1)
Set tabla = .CurrentRegion
f1 = .Rows.Count: c1 = .Columns.Count
For I = 1 To f1
registro = .Cells(I, 1)
fila = funcion.Match(registro, datos.Columns(4), 0)
.Cells(I, 2) = datos.Cells(fila, 1)
.Cells(I, 3) = CDate(datos.Cells(fila, 2))
.Cells(I, 4) = datos.Cells(fila, 3)
Next I
.Columns(4).NumberFormat = "0.00"
.Columns(1).Clear
datos.Columns(4).EntireColumn.Delete
Set tabla = .Columns(2).CurrentRegion
With .Cells(0, 1)
.Value = "RESULTADOS MAXIMOS"
.Font.Bold = True
End With
.Name = "maximos"
End With
End With
End Sub
Sub totalizar()
Set maxi = Range("maximos")
Set funcion = WorksheetFunction
With maxi
f = .Rows.Count: c = .Columns.Count
Set tabla = .Columns(c + 2).Resize(f, c)
With tabla
.Columns(1).Value = maxi.Columns(1).Value
.RemoveDuplicates Columns:=Array(1)
Set tabla = .CurrentRegion
f = .Rows.Count: c = .Columns.Count
For I = 1 To f
.Cells(I, 2) = funcion.SumIf(maxi.Columns(1), .Cells(I, 1), maxi.Columns(3))
Next I
.Columns(2).NumberFormat = "0.00"
With .Cells(0, 1)
.Value = "RESULTADOS SEMANAL"
.Font.Bold = True
End With
End With
End With
End Sub
Al ingresar la macro al documento y ejecutarla me marca el siguiente error,
Pon las líneas que están en negritas, el error te lo marca porque campo fechas tiene un formato distinto
For I = 1 To f1
registro = .Cells(I, 1)
fila = funcion.Match(registro, datos.Columns(4), 0)
.Cells(I, 2) = datos.Cells(fila, 1)
.Cells(I, 3) = datos.Cells(fila, 2).Value
.Cells(I, 4) = datos.Cells(fila, 3)
Next I
.Columns(3).NumberFormat = "dd/mm/yyyy"
.Columns(4).NumberFormat = "0.00"
