Function ModaT
Esta función me la proporcionaste anteriormente
Public Function ModaT(ByRef Rango As Excel.Range) As String
Dim Texto As String
Dim Datos As Long
Dim I As Long
Dim Mayor As Long
Dim Cuantos As Long
Datos = WorksheetFunction.CountA(Range(Rango.Address))
Mayor = 0
ModaT = ""
For I = 1 To Datos
Texto = Cells(I, Range(Rango.Address).Column)
Cuantos = WorksheetFunction.CountIf(Range(Rango.Address), Texto)
If Cuantos > Mayor Then
Mayor = Cuantos
ModaT = Texto
ElseIf Cuantos = Mayor Then 'podrias usar la regla de decisión de cual de los 2 textos es más largo cuando ambos tienen igual frecuencia
If Len(Texto) > Len(ModaT) Then
ModaT = Texto
End If
End If
Next I
'Para activarla en la celda escribes la funcion como cualquiera de excel y le pasas un rango como parámetro.
End Function
Quiero saber si se puede hacer una función parecida a este pero que maneje jerarquías es decir que contenga un criterio con el cual si pongo el numero 1 me de el texto que más aparece en el rango si pongo 2 me de el texto que aparece más veces después de 1
Public Function ModaT(ByRef Rango As Excel.Range) As String
Dim Texto As String
Dim Datos As Long
Dim I As Long
Dim Mayor As Long
Dim Cuantos As Long
Datos = WorksheetFunction.CountA(Range(Rango.Address))
Mayor = 0
ModaT = ""
For I = 1 To Datos
Texto = Cells(I, Range(Rango.Address).Column)
Cuantos = WorksheetFunction.CountIf(Range(Rango.Address), Texto)
If Cuantos > Mayor Then
Mayor = Cuantos
ModaT = Texto
ElseIf Cuantos = Mayor Then 'podrias usar la regla de decisión de cual de los 2 textos es más largo cuando ambos tienen igual frecuencia
If Len(Texto) > Len(ModaT) Then
ModaT = Texto
End If
End If
Next I
'Para activarla en la celda escribes la funcion como cualquiera de excel y le pasas un rango como parámetro.
End Function
Quiero saber si se puede hacer una función parecida a este pero que maneje jerarquías es decir que contenga un criterio con el cual si pongo el numero 1 me de el texto que más aparece en el rango si pongo 2 me de el texto que aparece más veces después de 1
1 respuesta
Respuesta de jgirj
1
Esta es la solución que encontré, un poco complicado pero va:
Option Base 1
Option Explicit
Public Function ModaTj(ByRef Rango As Excel.Range, Orden As Integer) As String
'Rango: Lista de Valores
'Orden: Jerarquia del elemento a encontrar. Obviamente si el orden es mayor que el _
número de elementos no repetidos en la serie, la función devolvera un error.
Dim Texto As String
Dim Datos As Long
Dim Ordenados() As String
Dim Grupos() As Variant
Dim Posicion As Long
Dim Posicion_1 As Long
Dim FilaRango As Long
Dim ColumnaRango As Integer
Dim A As String
Dim B As String
Dim C As Long
Dim D As Long
Dim DatosNoRepetidos As Long
Datos = WorksheetFunction.CountA(Range(Rango.Address))
ReDim Ordenados(1 To Datos)
FilaRango = Rango.Row
ColumnaRango = Rango.Column
'Pone los datos del rango en la matriz
For Posicion = 1 To Datos
Ordenados(Posicion) = Cells(FilaRango, ColumnaRango)
FilaRango = FilaRango + 1
Next Posicion
'ordena los elementos del rango
For Posicion = 1 To Datos
A = Ordenados(Posicion)
For Posicion_1 = Posicion + 1 To Datos
B = Ordenados(Posicion_1)
If A > B Then
Ordenados(Posicion) = B
Ordenados(Posicion_1) = A
A = B
End If
Next Posicion_1
Next Posicion
'Cuenta los Datos no repetidos
DatosNoRepetidos = 0
Posicion_1 = 2
For Posicion = 1 To Datos
A = Ordenados(Posicion)
Do While Ordenados(Posicion_1) = Ordenados(Posicion)
Posicion_1 = Posicion_1 + 1
If Posicion_1 > UBound(Ordenados) Then
DatosNoRepetidos = DatosNoRepetidos + 1
Exit For
End If
Loop
DatosNoRepetidos = DatosNoRepetidos + 1
Posicion = Posicion_1 - 1
Posicion_1 = Posicion + 2
If Posicion_1 > UBound(Ordenados) Then
DatosNoRepetidos = DatosNoRepetidos + 1
Exit For
End If
Next Posicion
ReDim Grupos(1 To DatosNoRepetidos, 1 To 2)
Posicion = 1
Posicion_1 = 2
A = Ordenados(1)
Posicion_1 = 2
For Posicion = 1 To DatosNoRepetidos
Grupos(Posicion, 1) = A
If Posicion = DatosNoRepetidos Then
Exit For
End If
Do While A = Ordenados(Posicion_1)
Posicion_1 = Posicion_1 + 1
Loop
A = Ordenados(Posicion_1)
Posicion_1 = Posicion_1 + 1
Next Posicion
'Determina cuantas veces esta cada dato no repetido
For Posicion = 1 To DatosNoRepetidos
Grupos(Posicion, 2) = WorksheetFunction.CountIf(Range(Rango.Address), Grupos(Posicion, 1))
Next Posicion
'Ordena la matriz Grupos, con la segunda columna como clave de ordenamiento
For Posicion = 1 To DatosNoRepetidos
C = Grupos(Posicion, 2)
For Posicion_1 = Posicion + 1 To DatosNoRepetidos
D = Grupos(Posicion_1, 2)
If C < D Then
Grupos(Posicion, 2) = Grupos(Posicion_1, 2)
Grupos(Posicion_1, 2) = C
A = Grupos(Posicion, 1)
Grupos(Posicion, 1) = Grupos(Posicion_1, 1)
Grupos(Posicion_1, 1) = A
C = D
End If
Next Posicion_1
Next Posicion
ModaTj = Grupos(Orden, 1)
'Para activarla en la celda escribes la funcion como cualquiera de excel y le pasas un rango como parámetro.
End Function
Option Base 1
Option Explicit
Public Function ModaTj(ByRef Rango As Excel.Range, Orden As Integer) As String
'Rango: Lista de Valores
'Orden: Jerarquia del elemento a encontrar. Obviamente si el orden es mayor que el _
número de elementos no repetidos en la serie, la función devolvera un error.
Dim Texto As String
Dim Datos As Long
Dim Ordenados() As String
Dim Grupos() As Variant
Dim Posicion As Long
Dim Posicion_1 As Long
Dim FilaRango As Long
Dim ColumnaRango As Integer
Dim A As String
Dim B As String
Dim C As Long
Dim D As Long
Dim DatosNoRepetidos As Long
Datos = WorksheetFunction.CountA(Range(Rango.Address))
ReDim Ordenados(1 To Datos)
FilaRango = Rango.Row
ColumnaRango = Rango.Column
'Pone los datos del rango en la matriz
For Posicion = 1 To Datos
Ordenados(Posicion) = Cells(FilaRango, ColumnaRango)
FilaRango = FilaRango + 1
Next Posicion
'ordena los elementos del rango
For Posicion = 1 To Datos
A = Ordenados(Posicion)
For Posicion_1 = Posicion + 1 To Datos
B = Ordenados(Posicion_1)
If A > B Then
Ordenados(Posicion) = B
Ordenados(Posicion_1) = A
A = B
End If
Next Posicion_1
Next Posicion
'Cuenta los Datos no repetidos
DatosNoRepetidos = 0
Posicion_1 = 2
For Posicion = 1 To Datos
A = Ordenados(Posicion)
Do While Ordenados(Posicion_1) = Ordenados(Posicion)
Posicion_1 = Posicion_1 + 1
If Posicion_1 > UBound(Ordenados) Then
DatosNoRepetidos = DatosNoRepetidos + 1
Exit For
End If
Loop
DatosNoRepetidos = DatosNoRepetidos + 1
Posicion = Posicion_1 - 1
Posicion_1 = Posicion + 2
If Posicion_1 > UBound(Ordenados) Then
DatosNoRepetidos = DatosNoRepetidos + 1
Exit For
End If
Next Posicion
ReDim Grupos(1 To DatosNoRepetidos, 1 To 2)
Posicion = 1
Posicion_1 = 2
A = Ordenados(1)
Posicion_1 = 2
For Posicion = 1 To DatosNoRepetidos
Grupos(Posicion, 1) = A
If Posicion = DatosNoRepetidos Then
Exit For
End If
Do While A = Ordenados(Posicion_1)
Posicion_1 = Posicion_1 + 1
Loop
A = Ordenados(Posicion_1)
Posicion_1 = Posicion_1 + 1
Next Posicion
'Determina cuantas veces esta cada dato no repetido
For Posicion = 1 To DatosNoRepetidos
Grupos(Posicion, 2) = WorksheetFunction.CountIf(Range(Rango.Address), Grupos(Posicion, 1))
Next Posicion
'Ordena la matriz Grupos, con la segunda columna como clave de ordenamiento
For Posicion = 1 To DatosNoRepetidos
C = Grupos(Posicion, 2)
For Posicion_1 = Posicion + 1 To DatosNoRepetidos
D = Grupos(Posicion_1, 2)
If C < D Then
Grupos(Posicion, 2) = Grupos(Posicion_1, 2)
Grupos(Posicion_1, 2) = C
A = Grupos(Posicion, 1)
Grupos(Posicion, 1) = Grupos(Posicion_1, 1)
Grupos(Posicion_1, 1) = A
C = D
End If
Next Posicion_1
Next Posicion
ModaTj = Grupos(Orden, 1)
'Para activarla en la celda escribes la funcion como cualquiera de excel y le pasas un rango como parámetro.
End Function
