SumaProducto y SumarxColor
Tengo una función que suma los valores contenidos en celdas que cumplan un condición de color dentro de un rango (creo que esta función la hizo algún experto de todoexpertos), el código es el siguiente:
Function SumarxColor(RangoSuma As Range, CeldaColor As Range) As Double
Dim cll As Range
Dim Clr As Long
Clr = CeldaColor.Range("A1").Interior.Color
For Each cll In RangoSuma
If cll.Interior.Color = Clr Then
SumarxColor = SumarxColor + cll
End If
Next cll
End Function
Mi problema: estoy tratando de crear una función que combine la anterior y algo parecido a SumaProducto, es decir definiendo un color (condición) excel debe comparar dentro de un rango establecido si se cumple la condición, si es verdadero debe multiplicar ese valor por la celda correspondiente en otro rango.
Ej: al ejecutar la función me pide 3 datos celda color (suponiendo que la celda A1 está de color amarillo, le indico A1), RangoSuma (es el rango donde va a comparar el color de fondo de la celda), y RangoMultiplo (es el rango donde están los datos por los cuales se deben multiplicar los valores de rangosuma)
Si indico la celda A1 (color amarillo), Rango suma C1:C100 y RangoMultiplo D1:D100. Suponiendo que en rango suma las celdas C5, C8, C75 son de fondo amarillo, el resultado debería ser C5*D5+C8*D8+C75*D75. Estoy tratando con el siguiente código, pero no me ha dado resultados, agradecería si alguien me puede ayudar con esto.
Function SumaproductoxColor(RangoSuma As Range, CeldaColor As Range, CeldaMultiplo As Range) As Double
Dim cll As Range
Dim Clr As Long
Dim mlt As Range
Clr = CeldaColor.Range("A1").Interior.Color
For Each cll In RangoSuma
If cll.Interior.Color = Clr Then
SummultxColor = SummultxColor + cll * mlt
End If
Next cll
End Function
Function SumarxColor(RangoSuma As Range, CeldaColor As Range) As Double
Dim cll As Range
Dim Clr As Long
Clr = CeldaColor.Range("A1").Interior.Color
For Each cll In RangoSuma
If cll.Interior.Color = Clr Then
SumarxColor = SumarxColor + cll
End If
Next cll
End Function
Mi problema: estoy tratando de crear una función que combine la anterior y algo parecido a SumaProducto, es decir definiendo un color (condición) excel debe comparar dentro de un rango establecido si se cumple la condición, si es verdadero debe multiplicar ese valor por la celda correspondiente en otro rango.
Ej: al ejecutar la función me pide 3 datos celda color (suponiendo que la celda A1 está de color amarillo, le indico A1), RangoSuma (es el rango donde va a comparar el color de fondo de la celda), y RangoMultiplo (es el rango donde están los datos por los cuales se deben multiplicar los valores de rangosuma)
Si indico la celda A1 (color amarillo), Rango suma C1:C100 y RangoMultiplo D1:D100. Suponiendo que en rango suma las celdas C5, C8, C75 son de fondo amarillo, el resultado debería ser C5*D5+C8*D8+C75*D75. Estoy tratando con el siguiente código, pero no me ha dado resultados, agradecería si alguien me puede ayudar con esto.
Function SumaproductoxColor(RangoSuma As Range, CeldaColor As Range, CeldaMultiplo As Range) As Double
Dim cll As Range
Dim Clr As Long
Dim mlt As Range
Clr = CeldaColor.Range("A1").Interior.Color
For Each cll In RangoSuma
If cll.Interior.Color = Clr Then
SummultxColor = SummultxColor + cll * mlt
End If
Next cll
End Function
1 Respuesta
Respuesta de valedor
1
La siguiente fórmula hace lo que quieres...
Function SumaproductoxColor(RangoSuma As Range, CeldaColor As Range, CeldaMultiplo As Range) As Double
Dim c As Range
Dim Color As Long
Dim Suma As Double
Color = CeldaColor.Range("A1").Interior.Color
For Each c In RangoSuma
If c.Interior.Color = Color Then
Suma = Suma + (c * CeldaMultiplo.Cells(c.Row, 1).Value)
End If
Next c
SumaproductoxColor = Suma
End Function
Definir un rango a multiplicar como en este caso, es útil, cuando los rangos no "empiezan" en la misma fila, pero OJO "siempre" deben de tener el MISMO numero de filas, pero si los rangos siempre ocupan las misma filas pero diferentes columnas, bastaría con indicarle el primer rango e indicarle el numero de columnas a desplazarse a derecha o a izquierda para encontrar el valor a multiplicar.
Function SumaproductoxColor(RangoSuma As Range, CeldaColor As Range, CeldaMultiplo As Range) As Double
Dim c As Range
Dim Color As Long
Dim Suma As Double
Color = CeldaColor.Range("A1").Interior.Color
For Each c In RangoSuma
If c.Interior.Color = Color Then
Suma = Suma + (c * CeldaMultiplo.Cells(c.Row, 1).Value)
End If
Next c
SumaproductoxColor = Suma
End Function
Definir un rango a multiplicar como en este caso, es útil, cuando los rangos no "empiezan" en la misma fila, pero OJO "siempre" deben de tener el MISMO numero de filas, pero si los rangos siempre ocupan las misma filas pero diferentes columnas, bastaría con indicarle el primer rango e indicarle el numero de columnas a desplazarse a derecha o a izquierda para encontrar el valor a multiplicar.
