............ Foro Excel
Si no lo has hecho aún: REGISTRATE!!!

MINIMA SUMA DE CELDAS CONTIGUAS MAYOR QUE DETERMINADO VALOR

Ver el tema anterior Ver el tema siguiente Ir abajo

MINIMA SUMA DE CELDAS CONTIGUAS MAYOR QUE DETERMINADO VALOR

Mensaje por GalileoGali el Sáb Abr 19, 2008 8:08 pm

Suena como un "Destrabalenguas". Vena el archivo adjunto. En el Rango "A1:A22" hay valores, en D2 un valor Objetivo. Se trata de encontrar la suma de celdas contiguas que sea la menos Suma del conjunto de todas las Mayores e Iguales que el Objetivo (esto en analisis se le llama supremo, la menor de las cotas superiores). Queda claro que la cantidad de celdas ("sumandos") , meintras se trate de un grupo de contiguas, puede ser cualquiera entre 1 y 22.
Bueno vamos al grano. Este codigo pàrece que resuelve el problema:
Código:
Option Base 1

Sub buscarSumaSupremo()
Dim vValSuma As Variant 'Variant/Double para almacenar los Valores de MMULT
Dim strBase As String, vBase As Variant  'String de Constante Matricial del Rango a Evaluar.
'ArrayVariant apara alojar el rango
Dim strFact As String, strUnos As String, strPreZeros As String, strPostZeros As String
' Variables para armar la Constante Matricial de 0 y 1 >> strFact
'esta Constante Matricial establece que sumandos componen cada suma a evaluar on MMULT

Dim iCardBase As Integer  'Indice para recorrer de 1 a 22 la cantidad de sumandos en cada suma
Dim idesplaz As Integer  'Indice para establecewr a partir de que elemento se colocara el duo,
'o terceto o n-eto de Unos
Dim j As Integer  'Indice para recorrer vBase y armar strBase
Dim dblValSumaCandidata As Double 'mantiene en reserva la suma candidata y se va recargando con
'otra mejor
Dim strFactCandidata As String    ' cadena de "0" y "1" correspondiente a la combinacion que da
'por resultado dblValSumaCandidata
Dim dblObjetivo As Double 'Valor tomado de la celda D2 que representa el Objetivo. Se busca de
'todas las sumas contiguas que supere el objetivo: la menor ("supremo")


dblObjetivo = Range("D2").Value ' carga el Valor Objetivo, Tope Minimo a aproximar con las sumas
'superiores


vBase = Range("a1:a22").Value  'cargamos el variant con los valores del rango
dblValSumaCandidata = Application.Sum(vBase) 'carga con la suma maxima de todo el Rango y poder
'comparar
strFactCandidata = "{" & Application.Rept("1,", 21) & "1}" 'Constante Matricial rellena de "1"
'que corresponde con la suma de todos los elementos

ReDim Preserve vBase(1 To 22, 1) 'necesario??? para armar otra constante Matrcial con los Valores
'del rango: sumandos

'se arma la string de la Constante Matrcial con los sumandos
For j = 1 To 22
strBase = strBase & vBase(j, 1) & ";"
Next j
strBase = "{" & Left(strBase, Len(strBase) - 1) & "}" ' se quita el ultimo ";"
strBase = Replace(strBase, ",", ".") 'evitar comas decimales que se interpretan como separadores
'en la constante matricial

'Armar las constantes matrciales de "0" y "1"
'Vueltas de 1 sumando, dos sumandos, hasta 22 sumandos
For iCardBase = 1 To 22
strUnos = Application.Rept("1,", iCardBase)

'vueltas de cada grupo de m-unos, pero desplazandose un lugar a la derecha hasta el ultimo disponible
For idesplaz = 1 To (22 - iCardBase + 1)
strPreZeros = Application.Rept("0,", idesplaz - 1)
strPostZeros = Application.Rept(",0", 22 - iCardBase - idesplaz + 1)
If Len(strPostZeros) = 0 Then  'contemplar el caso en que la cadena de "0" de cierre es nula
strUnos = Left(strUnos, Len(strUnos) - 1) ' en ese caso a la cadena de Unos hay que sacarle el separador final
Else
strPostZeros = Right(strPostZeros, Len(strPostZeros) - 1) ' cuando no es nula a la cadena de "0" posterior le
'sobra el primer separador
End If
strFact = "{" & strPreZeros & strUnos & strPostZeros & "}" 'armado de la Constante matrcial
vValSuma = Application.Evaluate("=MMult(" & strFact & "," & strBase & ")") 'se obtiene Variant/Double con la suma
'correspondiente a la combinacion de 0 y 1 definida con strFact


If vValSuma(1) >= dblObjetivo And vValSuma(1) < dblValSumaCandidata Then 'se verifica suma obtenida sea mayor o=

'que el Objetivo y en caso de ser menor que la última guardada, reemplazarla en la variable dblValsumaCandidata
'simultaneamente guardar la Constante Matrcial que mejor la suma.
dblValSumaCandidata = vValSuma(1): strFactCandidata = strFact
End If

Next idesplaz
Next iCardBase
Range("F2:F23").FormulaArray = "=Transpose(" & strFactCandidata & ")*" & strBase

End Sub
Después de meditar otro poco el problema se me ocurrio que con una sola formula en una celda, podia obtenerse el valor de la suma que cumple con lo solcitado. Todo esta en el adjunto

Hoja1

 ADHI
110,036Objetivo  
28,953128,383  
310,232   
425,402   
51,549   
621,591   
718,758   
813,228   
913,246  128,411
106,336   
115,604   
1210,426   
1321,871   
1427,501   
153,175   
1616,195   
178,739   
1835,433   
1915,497   
2016,556   
2124,303   
2218,383   
Spreadsheet Formulas
CellFormula
D2=SUMA(A13:A19)-0,028
I9{=MIN(SI(SUBTOTALES(9;DESREF(A1:A22;FILA(A1:A22)-1;0;COLUMNA(F1:AA1);1))>=D2;SUBTOTALES(9;DESREF(A1:A22;FILA(A1:A22)-1;0;COLUMNA(F1:AA1);1));SUMA(A1:A22)))}
Formula Array:
Produce enclosing
{ } by entering
formula with CTRL+SHIFT+ENTER!


Excel tables to the web >> [Tienes que estar registrado y conectado para ver este vínculo]



DESCARGA DE ARCHIVO

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1962
Edad : 61
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Re: MINIMA SUMA DE CELDAS CONTIGUAS MAYOR QUE DETERMINADO VALOR

Mensaje por johnarsi el Miér Abr 23, 2008 12:50 pm

Hola, sucede que tengo que sumar 4 porcentajes distintos para llegar a un 100% estos son: 30%, 20%, 20%, 30% ¿Podrian indicarme el procedimiento a seguir? les quedo muy agradecido. Johnarsi.

johnarsi

Cantidad de envíos : 1
Fecha de inscripción : 23/04/2008

Volver arriba Ir abajo

Re: MINIMA SUMA DE CELDAS CONTIGUAS MAYOR QUE DETERMINADO VALOR

Mensaje por GalileoGali el Miér Abr 23, 2008 1:40 pm

Johnarsi: Bienvenido a Excelgali!!!
Hubiera sido preferible abrir un tema nuevo, para no mezclar con el anterior
Ahora bien podrias poner un ejemplo de lo que quieres lograr?

_________________
GalileoGali
M.A.P. 2010-2013
Microsoft Active Professional
avatar
GalileoGali
Admin

Masculino Cantidad de envíos : 1962
Edad : 61
Ciudad - Pais : QUIROGA, Argentina
Version de Excel : 2000-2003-2007-2010
Fecha de inscripción : 24/01/2008

http://excelgali.mejorforo.net

Volver arriba Ir abajo

Re: MINIMA SUMA DE CELDAS CONTIGUAS MAYOR QUE DETERMINADO VALOR

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.