Tengo una función para armar un rango para la función de Excel PERCENTIL.INC
, la misma procesa toda la data en forma correcta, pero al regresar el vector da error (VALOR!
). He logrado detectar que se debe a que el vector que regresa es de mas de 79.000 registros, creo que esa es la causa del error
¿Hay alguna manera de ampliar el stack?
El código es el siguiente:
' Función Que regresa el Vector Monto Facturado o Monto Pagado (De acuerdo a lo que se re-
' quiera en base a los parámetros, Edad, Tipo, Tipo Servicio y Sexo, Se usan los vectores
' Tipo, Tipo Servico, Monto Facturado (o Pagado) y Sexo. Todo para ordenar y extraer en
' Base a la edad
' Se Agrega el par{ametro UsoEdad, que es para restringir el uso o no de la edad como
' elemento de selección. Opera de la siguiente manera: Si es cero (0) se prescinde de
' la Edad como elemento de selección{on, cualquier otro valor toma la edad como elemento
' de selección.
' Tomar en cuenta que se crea una variable TMP con 200.000 posiciones, si la tabla (hoja)
' excede ese número hay que incrementar las posiciones
Public Function VctPercentil(UsoEdad As Integer, Edad As Integer, Tipo As Integer, _
TpoSrv As Integer, Sexo As Integer, vEdad As Range, vTipo As Range, _
vTipoSrv As Range, vMtoFact As Range, vSexo As Range) As Double()
Dim LinInE As Long
Dim Tmp(200000) As Double
Dim I, N, K As Long
Dim Rsl() As Double
Dim Trx As String
' Obtenemos el número de filas y columnas del rango seleccionado
LinInE = vEdad.Rows.Count
'Obtener vector (UsoEdad=0 Significa No tomar en cuenta la edad)
If UsoEdad <> 0 Then
For I = 1 To LinInE
If vEdad(I, 1) = Edad Then
If Tipo = 3 Then ' Todos
If TpoSrv <= 3 And vTipoSrv(I, 1) = TpoSrv Then ' Es individual (1 = Elect, 2= No elect. 3=Amb)
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 4 And (vTipoSrv(I, 1) = 1 Or vTipoSrv(I, 1) = 2) Then ' Combinación Electivas y no electivas
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 5 Then ' Combinación todos
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
End If
ElseIf Tipo = 1 And vTipo(I, 1) = Tipo Then ' Activos
If TpoSrv <= 3 And vTipoSrv(I, 1) = TpoSrv Then ' Es individual (1 = Elect, 2= No elect. 3=Amb)
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 4 Then ' Combinación Electivas y no electivas
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 5 Then ' Combinación todos
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
End If
ElseIf Tipo = 2 And vTipo(I, 1) = Tipo Then ' Inactivos
If TpoSrv <= 3 And vTipoSrv(I, 1) = TpoSrv Then ' Es individual (1 = Elect, 2= No elect. 3=Amb)
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 4 Then ' Combinación Electivas y no electivas
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 5 Then ' Combinación todos
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
End If
End If
End If
Next
Else
For I = 1 To LinInE
If Tipo = 3 Then ' Todos
If TpoSrv <= 3 And vTipoSrv(I, 1) = TpoSrv Then ' Es individual (1 = Elect, 2= No elect. 3=Amb)
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 4 And (vTipoSrv(I, 1) = 1 Or vTipoSrv(I, 1) = 2) Then ' Combinación Electivas y no electivas
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 5 Then ' Combinación todos
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
End If
ElseIf Tipo = 1 And vTipo(I, 1) = Tipo Then ' Activos
If TpoSrv <= 3 And vTipoSrv(I, 1) = TpoSrv Then ' Es individual (1 = Elect, 2= No elect. 3=Amb)
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 4 Then ' Combinación Electivas y no electivas
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 5 Then ' Combinación todos
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
End If
ElseIf Tipo = 2 And vTipo(I, 1) = Tipo Then ' Inactivos
If TpoSrv <= 3 And vTipoSrv(I, 1) = TpoSrv Then ' Es individual (1 = Elect, 2= No elect. 3=Amb)
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 4 Then ' Combinación Electivas y no electivas
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
ElseIf TpoSrv = 5 Then ' Combinación todos
If Sexo = 2 Then ' Ambos sexos
Tmp(I) = vMtoFact.Cells(I, 1)
ElseIf vSexo(I, 1) = Sexo Then ' Sexos separados
Tmp(I) = vMtoFact.Cells(I, 1)
End If
End If
End If
Next
End If
' Hallar dimensión vector resultante
On Error GoTo ErrA
Open "MGT.txt" For Output As #1
N = 0
For I = 1 To LinInE
If Tmp(I) <> 0 Then
N = N + 1
End If
Next
If N <> 0 Then
ReDim Rsl(N - 1)
' Almacenar en vector resultante
K = 0
For I = 1 To LinInE
If Tmp(I) <> 0 Then
Rsl(K) = Tmp(I)
Write #1, Rsl(K)
K = K + 1
End If
Next
VctPercentil = Rsl
Else
ReDim Rsl(0)
Tmp(0) = 0
Rsl(0) = Tmp(1)
VctPercentil = Rsl
End If
Close #1
Exit Function
ErrA:
Debug.Print Error, Err
End Function
La linea con la instrucción Open
la agregué para generar un archivo y verificar que toda la data era procesada, así mismo la instrucción ON ERROR
la agregué para verificar que no había error en la parte álgida de la función (Y no lo hay), el error se produce en el return (VctPercentil = Rsl)
.
No tengo ningún inconveniente en enviar una hoja resumen con toda la data y el código.