Como Ubicar Valor Min y Max de los valores visibles por condicion
Ya tengo un codigo en el cual filtra el empleado me recorre la base de datos por fecha de ese e, pleado y ubica los dias que existe (Col A) en esa base de datos, me indica la primera hora de una columna (N) osea (Hora de Entrada) y la ultima hora de la columna (O) (hora de salida) pero me resulta que lo hace con toda la base de datos y no con los datos visibles no se en donde tengo el error agradeceria la ayuda!
Adjunto el codigo
Sub DeterminarMinMAx()
Dim celda As Object
Dim i As Integer
Set UNICOS = New Collection
For Each celda In Range("A2:A20000")
On Error Resume Next
UNICOS.Add celda.Value, CStr(celda.Value)
On Error GoTo 0
Next celda
For i = 1 To UNICOS.Count
Sheets("JOB").Range("R1").Offset(i - 1, 0).Value = UNICOS(i)
Range("A1").Select
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:=UNICOS(i)
Application.ScreenUpdating = False
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim uf As String
Dim fila As Integer
uf = Sheets("Job").Range("N" & Rows.Count).End(xlUp).Row
Sheets("JOB").Range("S1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Min(Range("N1" & ":N" & uf))
On Error Resume Next
uf = Sheets("Job").Range("O" & Rows.Count).End(xlUp).Row
Sheets("JOB").Range("T1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Max(Range("O1" & ":O" & uf))
Selection.AutoFilter
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Next i
End Sub
1 Respuesta
[Hola
Sugiero que coloques tu archivo en algún "Drive" (Google Drive, OneDrive, DropBox, etc.) para poder entender bien tu dilema. No olvides compartir el enlace por aquí. No es necesario que estén todos tus datos, pero sí los suficientes para entender tu problema.
Abraham Valencia
PD: Hay abuso en el uso de "On Error Resume Next" en tu código
El link del archivo es https://1drv.ms/x/s!AnjRTSkVrt87iEI-_hD6pvo2hM58
Cabe destacar que la información que allí aparece es variante por lo que los rangos son dinámicos y en el vba coloque notas de información de los resultados correctos que debería arrojar dejame saber si queda alguna duda para comprender mejor
[Hola nuevamente
Prueba así:
Sub PRUEBA()
Dim celda As Range
Dim unicos As Collection
Dim i As Integer
Dim dDate As String
Dim uf As Long
Application.ScreenUpdating = False
Set unicos = New Collection
For Each celda In Range("A2:A50")
On Error Resume Next
unicos.Add celda.Value, CStr(celda.Value)
On Error GoTo 0
Next celda
uf = Sheets("Job").Range("O" & Rows.Count).End(xlUp).Row
For i = 1 To unicos.Count
Sheets("JOB").Range("S1").Offset(i - 1, 0).Value = unicos(i)
dDate = Format(unicos(i), "mm/dd/yy")
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:="=" & dDate
Sheets("JOB").Range("V1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Subtotal(5, Range("O2" & ":O" & uf))
Sheets("JOB").Range("W1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Subtotal(4, Range("P2" & ":P" & uf))
Rangesum = Range("Q2", ActiveSheet.Range("Q2").End(xlDown))
Range("X1").Formula = "=SUM(range(Rangesum))"
Selection.AutoFilter
Next i
Application.ScreenUpdating = True
End SubLas funciones "Max" y "Min", así sea con sus equivalente de VBA, toman en cuenta sí o sí todas las filas, por ende tenías que usar "Subtotales".
Saludos]
Abraham Valencia
PD: no me quedó claro qué querías hacer con esa suma de la última parte
Hola Nuevamente Abraham,
Excelente el código funciona mucho mejor así... y con respecto a la parte de la suma lo que requiero de ella es que sume la columna QUE en cada uno de los bucles osea en la fecha 29/04 sume lo valores de la col QUE que seria el total 136, para el día 30/04 seria 3150 y para el día 01/05 3570 y vaya colocando en la col POR el resultado en la fila respectiva de cada día no se si me dejo entender bien...
Hola Nuevamente Abraham,
Excelente el código funciona mucho mejor así... y con respecto a la parte de la suma lo que requiero de ella es que sume la columna Q en cada uno de los bucles osea en la fecha 29/04 sume lo valores de la col Q que seria el total 136, para el día 30/04 seria 3150 y para el día 01/05 3570 y vaya colocando en la col X el resultado en la fila respectiva de cada día no se si me dejo entender bien...
[Hola
Pues igual, cuestión de usar "Subtotales":
Sub PRUEBA()
Dim celda As Range
Dim unicos As Collection
Dim i As Integer
Dim dDate As String
Dim uf As Long
Application.ScreenUpdating = False
Set unicos = New Collection
Let uf = Sheets("Job").Range("O" & Rows.Count).End(xlUp).Row
For Each celda In Range("A2:A" & uf)
On Error Resume Next
unicos.Add celda.Value, CStr(celda.Value)
On Error GoTo 0
Next celda
For i = 1 To unicos.Count
Sheets("JOB").Range("S1").Offset(i - 1, 0).Value = unicos(i)
dDate = Format(unicos(i), "mm/dd/yy")
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:="=" & dDate
Sheets("JOB").Range("V1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Subtotal(5, Range("O2" & ":O" & uf))
Sheets("JOB").Range("W1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Subtotal(4, Range("P2" & ":P" & uf))
Sheets("JOB").Range("X1").Offset(i - 1, 0).Value = Application.WorksheetFunction.Subtotal(9, Range("Q2" & ":Q" & uf))
Selection.AutoFilter
Next i
Application.ScreenUpdating = True
End SubSaludos]
Abraham Valencia
