Función personalizada SUBTOTALES en Filas (Rango Horizontal)
Código Function SubtotalesColumnas(Funcion As Integer, ParamArray Rangos() As Variant) As Variant Application.Volatile Dim C As Range, J As Double, O As Double, Vlr() As Double, R As Long, G As Long, E As Long, Rng As Variant J = 0 O = 1 R = 0 G = 0 E = 0 On Error GoTo ManejoError For Each Rng In Rangos If TypeOf Rng Is Range Then For Each C In Rng If Not C.EntireColumn.Hidden Then If Not IsEmpty(C.Value) Then If IsNumeric(C.Value) Then E = E + 1 J = J + C.Value O = O * C.Value ReDim Preserve Vlr(R) Vlr(R) = C.Value R = R + 1 End If G = G + 1 End If End If Next C Else SubtotalesColumnas = CVErr(xlErrValue) Exit Function End If Next Rng Select Case Funcion Case 1 If E > 0 Then SubtotalesColumnas = WorksheetFunction.Average(Vlr) Else SubtotalesColumnas = CVErr(xlErrDiv0) End If Case 2 SubtotalesColumnas = E Case 3 SubtotalesColumnas = G Case 4 If E > 0 Then SubtotalesColumnas = WorksheetFunction.Max(Vlr) Else SubtotalesColumnas = CVErr(xlErrNum) End If Case 5 If E > 0 Then Subto...